Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPBONUS.ZIP/WFIELD.LZH/WFIELD3.PAS

Pascal/Delphi Source File | 1990-04-04 | 10.2 KB | 332 lines

{$V-}

(*
   WFIELD3
   -------

   This program is an example of a PickList embedded within a data entry
   screen. Points worth noting:

     1) The post-edit routine manages the interaction between the State
        field (a string) and the StateWin field (a pick list). As long as the
        string field is empty, the contents of the pick list are suppressed
        when the pick list is inactive. (Notice that ResetScreen must be
        called to redraw the entire window; otherwise only the frame for the
        pick list will be redrawn.) If the user presses <Enter> (ccSelect)
        while within the pick list, the abbreviation for the selected state is
        stored in the string field.

     2) The StateChoice routine does one of three things: 1) if the pick list
        is inactive and no choice has been made previously, it returns an
        empty string; 2) if the Mode is pkSearch, it returns the abbreviation
        for the state--this is what gets stored in the string field; or 3) if
        the Mode is not pkSearch, it returns the complete name of the
        state--this is what gets displayed in the pick list.

     3) The PickList's SetSearchMode method enables character-based searching
        within the pick list. (Try pressing 'N' repeatedly, for example.)

     4) By activating the sefSwitchCommands option before calling
        AddWindowField, we tell OPENTRY to make the PickList use the same
        CommandProcessor as the EntryScreen. This allows commands such as
        ccTab, which normally have no meaning in a PickList, to produce the
        same effects that they have when issued within the EntryScreen itself.

     5) Notice how the wAltFrame option lets us "highlight" the PickList when
        it becomes active: the active frame has special headers; the inactive
        frame does not.

     6) The wNoCoversBuffer option is used for the PickList field to limit
        memory usage.

*)

program WFIELD3;

{$I OPDEFINE.INC}

uses
  Dos,
  OpInline,
  OpString,
  OpRoot,
  OpCrt,
  {$IFDEF UseMouse}
  OpMouse,
  {$ENDIF}
  OpAbsFld,
  OpCmd,
  OpField,
  OpFrame,
  OpWindow,
  OpPick,
  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     : $1F; HeaderMono      : $0F;
    ShadowColor     : $09; ShadowMono      : $0F;
    HighlightColor  : $4F; HighlightMono   : $70;
    PromptColor     : $1B; PromptMono      : $07;
    SelPromptColor  : $1B; SelPromptMono   : $07;
    ProPromptColor  : $1B; ProPromptMono   : $07;
    FieldColor      : $1E; FieldMono       : $0F;
    SelFieldColor   : $3E; SelFieldMono    : $70;
    ProFieldColor   : $1F; 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;
  idStateWin             = idCity + 1;
  idState                = idStateWin + 1;
  idZipCode              = idState + 1;
  idPhone                = idZipCode + 1;

type
  UserRecord =
    record
      Name                 : string[25];
      Address              : string[25];
      City                 : string[25];
      State                : string[2];
      ZipCode              : string[10];
      Phone                : string[14];
    end;
var
  ES     : EntryScreen;
  PL     : PickList;
  UR     : UserRecord;
  Status : Word;

const
  StateStrings : array[1..51] of string[19] = (
    {01} 'AK Alaska',         {02} 'AL Alabama',          {03} 'AR Arkansas',
    {04} 'AZ Arizona',        {05} 'CA California',       {06} 'CO Colorado',
    {07} 'CT Connecticut',    {08} 'DC Dist of Columbia', {09} 'DE Delaware',
    {10} 'FL Florida',        {11} 'GA Georgia',          {12} 'HI Hawaii',
    {13} 'IA Iowa',           {14} 'ID Idaho',            {15} 'IL Illinois',
    {16} 'IN Indiana',        {17} 'KS Kansas',           {18} 'KY Kentucky',
    {19} 'LA Louisana',       {20} 'MA Massachusetts',    {21} 'MD Maryland',
    {22} 'ME Maine',          {23} 'MI Michigan',         {24} 'MN Minnesota',
    {25} 'MO Missouri',       {26} 'MS Mississippi',      {27} 'MT Montana',
    {28} 'NC North Carolina', {29} 'ND North Dakota',     {30} 'NE Nebraska',
    {31} 'NH New Hampshire',  {32} 'NJ New Jersey',       {33} 'NM New Mexico',
    {34} 'NV Nevada',         {35} 'NY New York',         {36} 'OH Ohio',
    {37} 'OK Oklahoma',       {38} 'OR Oregon',           {39} 'PA Pennsylvania',
    {40} 'RI Rhode Island',   {41} 'SC South Carolina',   {42} 'SD South Dakota',
    {43} 'TN Tennessee',      {44} 'TX Texas',            {45} 'UT Utah',
    {46} 'VA Virginia',       {47} 'VT Vermont',          {48} 'WA Washington',
    {49} 'WI Wisconsin',      {50} 'WV West Virginia',    {51} 'WY Wyoming');

{$F+}
procedure StateChoice(Item : Word; Mode : pkMode;
                      var IType : pkItemType;
                      var IString : string;
                      PickPtr : PickListPtr);
  {-Return a state string given an index}
begin
  {blank out pick list if no choice has been made and pick list is inactive}
  if (UR.State = '') and (ES.ActiveChild <> Pointer(PickPtr)) then
    IString := ''
  else if (Mode = pkSearch) then begin
    {return only the first two characters -- the abbreviation}
    IString := StateStrings[Item];
    IString[0] := #2;
  end
  else
    {return the full name and ignore the abbreviation}
    IString := Copy(StateStrings[Item], 3, 255);
end;

procedure PostEdit(ESP : EntryScreenPtr);
  {-Called just after a field has been edited}
begin
  with ESP^ do
    if (GetCurrentID = idStateWin) then
      if (GetLastCommand = ccSelect) then begin
        {store the user's choice}
        UR.State := Trim(StateStrings[PL.GetLastChoice]);
        DrawField(idState);
      end
      {blank out the pick list if no selection has been made}
      else if (UR.State = '') then
        ResetScreen;
end;
{$F-}

function InitEntryScreen : Word;
  {-Initialize entry screen generated by MAKESCRN}
const
  WinOptions = wBordered+wClear+wUserContents;
begin
  with ES do begin
    if not InitCustom(20, 9, 59, 16, EsColors, WinOptions) then begin
      InitEntryScreen := InitStatus;
      Exit;
    end;

    wFrame.SetFrameType(SglWindowFrame);
    wFrame.AddShadow(shBR, shOverWrite);
    SetWrapMode(WrapAtEdges);

    SetPostEditProc(PostEdit);

  {idName:}
    AddStringField(
      'Name', 1, 7,
      CharStr('X', 25), 1, 13, 25,
      1, UR.Name);

  {idAddress:}
    AddStringField(
      'Address', 2, 4,
      CharStr('X', 25), 2, 13, 25,
      2, UR.Address);

  {idCity:}
    AddStringField(
      'City', 3, 7,
      CharStr('X', 25), 3, 13, 25,
      3, UR.City);

  {idStateWin:}
    esSecFieldOptionsOn(sefSwitchCommands);
    AddWindowField(
      '', 4, 17,
      4, 17,
      4, PL);
    esSecFieldOptionsOff(sefSwitchCommands);

  {idState:}
    esFieldOptionsOn(efProtected);
    AddStringField(
      'State', 5, 6,
      'XX', 5, 13, 2,
      5, UR.State);
    esFieldOptionsOff(efProtected);

  {idZipCode:}
    AddStringField(
      'Zip', 7, 8,
      '99999-9999', 7, 13, 10,
      6, UR.ZipCode);

  {idPhone:}
    AddStringField(
      'Phone', 8, 6,
      '[phone]', 8, 13, 14,
      7, UR.Phone);

    InitEntryScreen := RawError;
  end;
end;

function InitPickList : Word;
  {-Initialize the pick list}
const
  WinOptions = wBordered+wAltFrame+wClear+wUserContents+wNoCoversBuffer;
begin
  with PL do begin
    if not InitCustom(
      36, 13, 53, 13, EsColors, WinOptions, 18, 51,
      StateChoice, PickVertical, SingleChoice) then begin
        InitPickList := InitStatus;
        Exit;
      end;

    pkOptionsOff(pkDrawActive);
    SetSearchMode(PickCharSearch);

    wFrame.SetFrameType(DblWindowFrame);

    AddMoreHeader(' || ', heBR, #24, #25, '', 2, 3, 0);

    aFrame.SetFrameType(SglWindowFrame);

    InitPickList := RawError;
  end;
end;

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);
      PickCommands.cpOptionsOn(cpEnableMouse);
    end;
  {$ENDIF}

  {initialize pick list}
  Status := InitPickList;
  if Status <> 0 then begin
    WriteLn('Error initializing pick list: ', Status);
    Halt(1);
  end;

  {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);

  {test entry screen}
  ES.Process;

  {$IFDEF UseMouse}
  HideMouse;
  {$ENDIF}

  {erase the window}
  ES.Erase;

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

  {dispose of the parent *and* its children}
  ES.Done;
end.