Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPBONUS.ZIP/ENTRYL.LZH/ENTRYL.PAS

Pascal/Delphi Source File | 1990-06-04 | 5.8 KB | 248 lines

{$V-}

program ENTRYL;

{$I OPDEFINE.INC}

{$DEFINE TestStream}

uses
  Dos,
  OpDos,
  OpInline,
  OpString,
  OpRoot,
  OpCrt,
  {$IFDEF UseMouse}
  OpMouse,
  {$ENDIF}
  OpAbsFld,
  OpCmd,
  OpField,
  OpFrame,
  OpWindow,
  OpSelect,
  OpEntry;

  {$IFDEF UseMouse}
const
  MouseChar  : Char = #04;
  {$ENDIF}

{Color set used by entry screen}
const
  EsColors : ColorSet = (
    TextColor       : $1E; TextMono        : $0F;
    CtrlColor       : $1E; CtrlMono        : $0F;
    FrameColor      : $1F; FrameMono       : $0F;
    HeaderColor     : $3F; HeaderMono      : $70;
    ShadowColor     : $08; ShadowMono      : $0F;
    HighlightColor  : $4F; HighlightMono   : $70;
    PromptColor     : $1F; PromptMono      : $07;
    SelPromptColor  : $1F; SelPromptMono   : $07;
    ProPromptColor  : $17; ProPromptMono   : $07;
    FieldColor      : $1E; FieldMono       : $07;
    SelFieldColor   : $31; SelFieldMono    : $0F;
    ProFieldColor   : $17; ProFieldMono    : $07;
    ScrollBarColor  : $13; ScrollBarMono   : $07;
    SliderColor     : $13; SliderMono      : $0F;
    HotSpotColor    : $30; HotSpotMono     : $70;
    BlockColor      : $3E; BlockMono       : $0F;
    MarkerColor     : $3F; MarkerMono      : $70;
    DelimColor      : $1E; DelimMono       : $0F;
    SelDelimColor   : $31; SelDelimMono    : $0F;
    ProDelimColor   : $1E; ProDelimMono    : $0F;
    SelItemColor    : $3E; SelItemMono     : $70;
    ProItemColor    : $17; ProItemMono     : $07;
    HighItemColor   : $1F; HighItemMono    : $0F;
    AltItemColor    : $1F; AltItemMono     : $0F;
    AltSelItemColor : $3F; AltSelItemMono  : $70;
    FlexAHelpColor  : $1F; FlexAHelpMono   : $0F;
    FlexBHelpColor  : $1F; FlexBHelpMono   : $0F;
    FlexCHelpColor  : $1B; FlexCHelpMono   : $70;
    UnselXrefColor  : $1E; UnselXrefMono   : $09;
    SelXrefColor    : $3F; SelXrefMono     : $70;
    MouseColor      : $4F; MouseMono       : $70
  );

{Entry field constants}
const
  idName                 = 0;
  idAddress              = idName + 1;
  idCity                 = idAddress + 1;
  idState                = idCity + 1;
  idZipCode              = idState + 1;

type
  UserRecord =
    record
      Name                 : string[30];
      Address              : string[30];
      City                 : string[20];
      State                : string[2];
      ZipCode              : string[10];
    end;
var
  ES     : EntryScreen;
  UR     : UserRecord;
  Status : Word;
  {$IFDEF TestStream}
  L      : Library;
  {$ENDIF}

{$IFDEF TestStream}

procedure RegisterTypes(var S : IdStream);
  {-Register data types and pointers}
begin
  {register entry screen}
  S.RegisterHier(EntryScreenStream);

  {register field types}
  S.RegisterHier(StringFieldStream);

  {register user record}
  S.RegisterPointer(1000, @UR);
end;

{$ENDIF}

function InitEntryScreen : Word;
  {-Initialize entry screen generated by MAKESCRN}
const
  Frame1 = '┌└┐┘──││';
  WinOptions = wBordered+wClear+wUserContents;
begin
  with ES do begin
    if not InitCustom(20, 10, 60, 16, EsColors, WinOptions) then begin
      InitEntryScreen := InitStatus;
      Exit;
    end;

    wFrame.SetFrameType(Frame1);
    wFrame.AddShadow(shBR, shSeeThru);
    wFrame.AddHeader(' Entry 1 ', heTC);
    esFieldOptionsOn(efClearFirstChar);
    SetWrapMode(WrapAtEdges);

  {idName:}
    AddStringField(
      'Name:', 2, 5,
      CharStr('X', 30), 2, 11, 30,
      1, UR.Name);

  {idAddress:}
    AddStringField(
      'Address:', 3, 2,
      CharStr('X', 30), 3, 11, 30,
      2, UR.Address);

  {idCity:}
    AddStringField(
      'City:', 4, 5,
      'XXXXXXXXXXXXXXXXXXXX', 4, 11, 20,
      3, UR.City);

  {idState:}
    AddStringField(
      'State:', 5, 4,
      'AA', 5, 11, 2,
      4, UR.State);

  {idZipCode:}
    AddStringField(
      'Zip:', 6, 6,
      '99999 9999', 6, 11, 10,
      5, UR.ZipCode);

    InitEntryScreen := RawError;
  end;
end;

{*** sample test code follows ***}

begin
  ClrScr;

  {$IFDEF UseMouse}
  if MouseInstalled then
    with EsColors do begin
      {activate mouse cursor}
      SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
                             Byte(MouseChar));
      ShowMouse;
      {enable mouse support}
      EntryCommands.cpOptionsOn(cpEnableMouse);
    end;
  {$ENDIF}

  {initialize entry screen}
  Status := InitEntryScreen;
  if Status <> 0 then begin
    WriteLn('Error initializing entry screen: ', Status);
    Halt(1);
  end;

  {initialize user record}
  FillChar(UR, SizeOf(UR), 0);

  {$IFDEF TestStream}

  {set user record}
  ES.SetUserRecord(UR, SizeOf(UR));

  {does library exist?}
  if ExistFile('ENTRY1.OPL') then begin
    {open library}
    L.Init('ENTRY1.OPL', SOpen, 4096, '');
    if L.GetStatus <> 0 then begin
      WriteLn('Error opening library');
      Halt(1);
    end;
  end
  else begin
    {create library}
    L.Create('ENTRY1.OPL', 4096, '', 15);
    if L.GetStatus <> 0 then begin
      WriteLn('Error creating library');
      Halt(1);
    end;
  end;

  {register types and store the entry screen}
  RegisterTypes(L);
  L.PutEntry('ENTRY1', ES);
  if L.GetStatus <> 0 then begin
    WriteLn('Store error');
    Halt(2);
  end;
  L.Done;
  ES.Done;

  {reopen library}
  L.Init('ENTRY1.OPL', SOpen, 4096, '');

  {register types and load the entry screen}
  RegisterTypes(L);
  L.GetEntry('ENTRY1', ES);
  if L.GetStatus <> 0 then begin
    WriteLn('Load error');
    Halt(3);
  end;
  L.Done;

  {$ENDIF}

  {test entry screen}
  ES.Process;
  ES.Erase;

  {show exit command}
  WriteLn('Exit command = ', ES.GetLastCommand);
  ES.Done;

  {$IFDEF UseMouse}
  HideMouse;
  {$ENDIF}
end.