Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/OPHPCK.ZIP/HPTEST.PAS

Pascal/Delphi Source File | 1990-10-10 | 10.3 KB | 303 lines

(*
 This program demonstrates the OPHPICK unit, which provides an HPickList
 object derived from the PickList. HPickList manages a single column of pick
 items and remaps the ccLeft and ccRight (left and right arrow) commands so
 that individual items in the list will scroll horizontally (all at the same
 time). This is useful when the length of each item string exceeds the width
 of the pick window. HPickList supports all features of the PickList object,
 including multiple choice lists, flexwriting, scroll bars, mouse support,
 item searching, protected items, and so on, with the single exception that it
 does not allow lists with more than one column of items.

 To work with HPickList, you must write a specialized user string procedure,
 demonstrated by the example below. The procedure is much like the one
 normally used with a PickList, but it is passed an additional parameter,
 HScroll, which indicates the amount of horizontal scrolling. If HScroll is 0,
 no scrolling has occurred and each item is displayed starting with its first
 character. If HScroll is 1, the first column of each string does not appear,
 and so on. It is the string procedure's responsibility to copy the desired
 section of the overall string based on the value of HScroll. Note that if
 flexwriting is activated, the string procedure must take special steps to
 ensure that the flex characters are inserted correctly when HScroll is
 non-zero. The example below also illustrates this when you define the
 DemoFlex conditional.

 Also note that when the string procedure is called with Mode=pkSearch, you'll
 probably want to return the unscrolled version of the string regardless of
 the value of HScroll. The example also shows how to do this. The
 GetLastChoiceString method of PickList calls the string procedure in pkSearch
 mode, so GetLastChoiceString will return the full string regardless of
 scrolling only if you make the kind of check shown below.

 An HPickList is initialized by calling one of its constructors -- Init,
 InitCustom, InitAbstract, InitDeluxe, or InitAbstractDeluxe. The "abstract"
 constructors should be used only when an object derived from HPickList has
 overridden the HItemString method of HPickList. The other constructors are
 used to specify a user-written string procedure, just like the constructors
 for a PickList. The InitDeluxe constructor provides the most versatile
 control over instantiation of an HPickList:

    constructor InitDeluxe(X1, Y1, X2, Y2 : Byte;
                           var Colors : ColorSet;
                           Options : LongInt;
                           MaxItemWidth : Word;
                           NumItems : Word;
                           StringProc : hpStringProc;
                           CommandHandler : pkGenlProc;
                           PickOptions : Word);

 With two exceptions, the InitDeluxe parameters are used exactly like those
 for a PickList. MaxItemWidth specifies the maximum string string from which
 the string procedure is returning subsections. This length controls the
 amount of horizontal scrolling that the HPickList will allow: just enough to
 allow the rightmost edge of the longest string to appear within the window.
 HPickList automatically deals with the situation that occurs when
 MaxItemWidth is less than the window width; in this case, no horizontal
 scrolling will be necessary.

 The other difference is that the HPickList string procedure is of type
 hpStringProc:

    hpStringProc =
      procedure (Item : Word;
                 Mode : pkMode;
                 HScroll : Word;
                 var IType : pkItemType;
                 var IString : String;
                 HPickPtr : HPickListPtr);

 This procedure type is almost identical to the PickList's string procedure.
 As usual, the string procedure must be global and compiled under the FAR
 model. The HScroll parameter specifies the amount of horizontal scrolling
 currently active. Alternatively, the application may derive a new object
 based on HPickList and override the HItemString virtual method.

 InitDeluxe and the other HPickList constructors will fail only if the
 PickList constructor they call fails.

 A left selection string (specified by calling SetSelectMarker) always appears
 at the left edge of the window regardless of scrolling, but the right
 selection string appears only when the rightmost edge of the item string
 scrolls into view. The example illustrates this effect when you define
 DemoMulti below.

 OPHPICK provides stream support with the Load and Store methods and the
 HPickListStream registration procedure. Note that its stream constants are
 stored in OPHPICK rather than in OPROOT. Activate the DemoStreams define
 below to see the streams support.

 OPHPICK also provides access methods for reading the current amount of
 horizontal scrolling (GetCurrentCol) and for reading and changing the
 specified maximum item width (GetMaxWidth and SetMaxWidth).

 OPHPICK works by overriding PickList's ItemString virtual method and by
 taking over several of the PickList's "primitive move action procedures." See
 the OPHPICK source code for more information.

 Written by TurboPower Software, 10/10/90.
*)

{$R-,S-,F-}

{$I OPDEFINE.INC}

{.$DEFINE DemoFlex}           {Activate to demonstrate flexwriting}
{.$DEFINE DemoMulti}          {Activate to demonstrate multiple choice}
{.$DEFINE DemoStreams}        {Activate to demonstrate streams}

program HpTest;
  {-Test OpHpick unit}

uses
  opInline,
  opString,
  opRoot,
  opCrt,
  {$IFDEF UseMouse}
  opMouse,
  {$ENDIF}
  opFrame,
  opWindow,
  opCmd,
  {$IFDEF UseDrag}
  opDrag,
  {$ENDIF}
  opPick,
  opHpick;

const
  NumItems = 200;
  MaxItemWidth = 57;
  ItemAttr : FlexAttrs = ($07, $0F, $01, $70);

var
  P : HPickList;
  MAttr : Word;
  {$IFDEF DemoStreams}
  S : BufIdStream;
  Status : Word;
  {$ENDIF}

{$F+}
procedure SProc(Item : Word; Mode : pkMode; HScroll : Word;
                var IType : pkItemType; var IString : String;
                HPickPtr : HPickListPtr);
var
  NumStr : string[8];
begin
  {Exit quickly if just checking mode}
  if Mode = pkGetType then
    Exit;

  {Use a simple item string for the example program}
  Str(Item:3, NumStr);
  IString := NumStr+'. ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';

  {Return the unscrolled string if searching}
  if Mode = pkSearch then
    Exit;

  {Take a substring based on the amount of scrolling specified}
  IString := Copy(IString, HScroll+1, 255);

  {$IFDEF DemoFlex}
  {Insert flex characters carefully!}
  if Mode = pkDisplay then
    if HScroll < 4 then begin
      Insert(^A, IString, 5-HScroll);
      Insert(^A, IString, 1);
    end;
  {$ENDIF}
end;
{$F-}

{$IFDEF DemoStreams}
procedure RegisterTypes(var S : IdStream);
  {-Register types for this h-pick list stream}
begin
  S.RegisterHier(HPickListStream);
  {$IFDEF DemoMulti}
  S.RegisterPointer(ptPickMultipleChoice, @MultipleChoice);
  {$ELSE}
  S.RegisterPointer(ptPickSingleChoice, @SingleChoice);
  {$ENDIF}
  S.RegisterPointer(1000, @SProc);
end;
{$ENDIF}

begin
  {$IFDEF UseMouse}
  if MouseInstalled then begin
    {Enable mouse support}
    with DefaultColorSet do
      MAttr := (ColorMono(MouseColor, MouseMono) shl 8);
    SoftMouseCursor($0000,  MAttr or $04);
    PickCommands.cpOptionsOn(cpEnableMouse);

    {$IFDEF UseDrag}
    PickCommands.SetMouseCursor(MAttr or $04, MAttr or $12, MAttr or $1D);
    {$ENDIF}
    ShowMouse;
  end;
  {$ENDIF}

  {$IFDEF DemoStreams}
  if ParamCount = 0 then
  {$ENDIF}
    begin
      if not p.Init(10, 5, 31, 20, MaxItemWidth, NumItems, SProc,
                    {$IFDEF DemoMulti}
                    MultipleChoice
                    {$ELSE}
                    SingleChoice
                    {$ENDIF}
                    ) then begin
        WriteLn('error initializing');
        Halt;
      end;
      p.wOptionsOn(wBordered);
      p.SetSizeLimits(4, 3, ScreenWidth, ScreenHeight);

      {$IFDEF DemoMulti}
      p.SetSelectMarker(#16, #17);
      {Add horizontal scrolling space for selection markers}
      p.SetMaxWidth(MaxItemWidth+2);
      {$ENDIF}

      {$IFDEF DemoFlex}
      p.SetPickFlex(pkNormal, False, ItemAttr, ItemAttr);
      {$ENDIF}

      {$IFDEF UseScrollBars}
      {add scroll bars}
      p.wFrame.AddCustomScrollBar(frBB, 0, MaxLongInt, 1, 1, #178, #176, DefaultColorSet);
      p.wFrame.AddCustomScrollBar(frRR, 0, MaxLongInt, 1, 1, #178, #176, DefaultColorSet);
      {$ENDIF}

      {$IFDEF UseDrag}
      {add hot spot for zooming}
      p.wFrame.AddCustomHeader(#24, frTR, -1, 0,
                               DefaultColorSet.HeaderColor,
                               DefaultColorSet.HeaderMono);
      p.wFrame.AddHotRegion(frTR, ZoomHotCode, -1, 0, 1, 1);

      {add hot spot for moving}
      p.wFrame.AddHotBar(frTT, MoveHotCode);

      {add hot spot for resizing}
      p.wFrame.AddCustomHeader(#240, frBR, 0, 0,
                               DefaultColorSet.FrameColor,
                               DefaultColorSet.FrameMono);
      p.wFrame.AddHotRegion(frBR, ResizeHotCode, 0, 0, 1, 1);
      {$ENDIF}
    end;

  {$IFDEF DemoStreams}
  if ParamCount = 0 then begin
    {Create stream file and store the list}
    S.Init('HPTEST.STM', SCreate, 4096);
    RegisterTypes(S);
    S.Put(p);
    Status := S.GetStatus;
    if Status <> 0 then begin
      WriteLn('Store error: ', Status);
      Halt(1);
    end;
    S.Done;

    {Dispose of the list}
    P.Done;
  end;

  {Reopen stream file and reload list}
  S.Init('HPTEST.STM', SOpen, 4096);
  RegisterTypes(S);
  S.Get(P);
  Status := S.GetStatus;
  if Status <> 0 then begin
    WriteLn('Load error: ', Status);
    WriteLn('InitStatus: ', InitStatus);
    Halt(3);
  end;
  S.Done;
  {$ENDIF}

  repeat
    p.Process;
    {$IFDEF UseDrag}
    if p.GetLastCommand = ccMouseDown then
       if HandleMousePress(p) = hsNone then ;
    {$ENDIF}
  until p.GetLastCommand in [ccSelect, ccQuit, ccError];

  p.Erase;

  HideMouse;
  GoToXy(1, 20);
  WriteLn('last command: ', p.getlastcommand);
  WriteLn('last choice:  ', p.getlastchoice);
  WriteLn('last string:  ', p.getlastchoicestring);

  p.Done;
end.