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

Pascal/Delphi Source File | 1992-11-20 | 15.2 KB | 474 lines

{$R-,S-,I-,V-,B-,F+,O+,A-}

{Conditional defines that may affect this unit}
{$I OPDEFINE.INC}

{*********************************************************}
{*                   OPHPICK.PAS 1.03                    *}
{*      Copyright (c) TurboPower Software 1987,1989.     *}
{*                 All rights reserved.                  *}
{*********************************************************}

unit OpHPick;
  {-Single column pick with horizontal scroll}

interface

uses
  OpInline,
  OpString,
  {$IFDEF OPro12}
  OpConst,
  {$ENDIF}
  OpRoot,
  OpCrt,
  {$IFDEF UseMouse}
  OpMouse,
  {$ENDIF}
  OpCmd,
  OpFrame,
  OpWindow,
  {$IFDEF UseDrag}
  OpDrag,
  {$ENDIF}
  OpPick;

  {.F-}
const
  {Stream codes}
  otHPickList      = 300;
  veHPickList      = 00;
  ptNoHPickString  = 300;

type
  HPickListPtr     = ^HPickList;

  hpStringProc     =
    procedure (Item : Word;
               Mode : pkMode;
               HScroll : Word;    {Horizontal scroll offset}
               var IType : pkItemType;
               var IString : String;
               HPickPtr : HPickListPtr);

  HPickList        =
    object(PickList)
      hpScroll     : Word;              {Scroll offset}
      hpMaxCols    : Word;              {Maximum columns in each item}
      hpString     : hpStringProc;      {String procedure}
      hpSetScroll  : pkSetScrollProc;   {Saved scroll procedure}

      constructor Init(X1, Y1, X2, Y2 : Byte;
                       MaxItemWidth : Word;
                       NumItems : Word;
                       StringProc : hpStringProc;
                       CommandHandler : pkGenlProc);
        {-Initialize a pick window}
      constructor InitCustom(X1, Y1, X2, Y2 : Byte;
                             var Colors : ColorSet;
                             Options : LongInt;
                             MaxItemWidth : Word;
                             NumItems : Word;
                             StringProc : hpStringProc;
                             CommandHandler : pkGenlProc);
        {-Initialize a pick window with custom window options}
      constructor InitAbstract(X1, Y1, X2, Y2 : Byte;
                               var Colors : ColorSet;
                               Options : LongInt;
                               MaxItemWidth : Word;
                               NumItems : Word;
                               CommandHandler : pkGenlProc);
         {-Constructor to be called by derived types that override
           the ItemString method}
      constructor InitDeluxe(X1, Y1, X2, Y2 : Byte;
                             var Colors : ColorSet;
                             Options : LongInt;
                             MaxItemWidth : Word;
                             NumItems : Word;
                             StringProc : hpStringProc;
                             CommandHandler : pkGenlProc;
                             PickOptions : Word);
        {-Initialize a pick window with custom window and pick options}
      constructor InitAbstractDeluxe(X1, Y1, X2, Y2 : Byte;
                                     var Colors : ColorSet;
                                     Options : LongInt;
                                     MaxItemWidth : Word;
                                     NumItems : Word;
                                     CommandHandler : pkGenlProc;
                                     PickOptions : Word);
         {-Constructor to be called by derived types that override the
           HItemString method, with custom pick options}

      function GetCurrentCol : Word;
        {-Get column currently displayed at left edge of window}
      function GetMaxWidth : Word;
        {-Get the maximum number of columns in any string}
      procedure SetMaxWidth(MaxItemWidth : Word);
        {-Change the maximum number of columns in any string}

      procedure ItemString(Item : Word; Mode : pkMode;
                           var IType : pkItemType;
                           var IString : String); virtual;
        {-Overrides picklist ItemString}
      procedure HItemString(Item : Word;
                            Mode : pkMode;
                            HScroll : Word;    {Horizontal scroll offset}
                            var IType : pkItemType;
                            var IString : String); virtual;
        {-Returns item string}

    {$IFDEF UseStreams}
      constructor Load(var S : IdStream);
        {-Load a pick list from a stream}
      procedure Store(var S : IdStream);
        {-Store a pick list in a stream}
    {$ENDIF}

      {.Z+}
      {$IFDEF UseAdjustableWindows}
      procedure AdjustWindow(X1, Y1, X2, Y2 : Word); virtual;
      {$ENDIF}
      procedure hpSetPrimMoves;
      {.Z-}
    end;
  {.F+}

  procedure NoHPickString(Item : Word; Mode : pkMode; HScroll : Word;
                          var IType : pkItemType; var IString : String;
                          HPickPtr : HPickListPtr);
    {-Dummy string procedure used for HPickList derivatives}

{$IFDEF UseStreams}
  {---- Stream registration ----}
  procedure HPickListStream(SPtr : IdStreamPtr);
    {-Register all types needed for streams containing h-pick lists}
{$ENDIF}

  {====================================================================}

implementation

{$F+}
procedure ReinitHPick(P : PickListPtr);
  {-Reinitialize some fields based on width, height and orientation}
var
  MaxHz : Word;
begin
  with HPickListPtr(P)^ do begin
    {pkMaxFirst controls how much vertical scrolling, if any, is possible}
    pkMaxFirst := pkItemRows-pkHeight+1;
    {Amount to change pkFirst by when scrolling}
    pkScroll := 1;
    {$IFDEF UseScrollBars}
    {Set up for scroll bars}
    if hpMaxCols <= Width then
      MaxHz := 0
    else
      MaxHz := hpMaxCols-Width;
    ChangeAllScrollBars(0, MaxHz, 1, pkItemRows);
    {$ENDIF}
  end;
end;

procedure LeftAction(P : PickListPtr);
  {-Handle left arrow movements}
begin
  with HPickListPtr(P)^ do
    if hpScroll > 0 then begin
      dec(hpScroll);
      SetFlag(pkSecFlags, pkRedrawPage);
    end;
end;

procedure RightAction(P : PickListPtr);
  {-Handle right arrow movements}
begin
  with HPickListPtr(P)^ do
    if hpScroll+Width < hpMaxCols then begin
      inc(hpScroll);
      SetFlag(pkSecFlags, pkRedrawPage);
    end;
end;

{$IFDEF UseScrollBars}
procedure UpdScrollHPick(P : PickListPtr);
  {-Update scroll bars for vertical orientation}
begin
  with HPickListPtr(P)^ do
    DrawAllSliders(hpScroll, pkFirst+pkRow-1);
end;

procedure SetScrollHPick(FramePos : FramePosType;
                         MPosX, MPosY : Byte;
                         UserVal : LongInt; P : PickListPtr);
  {-Set pick position based on slider position}
var
  nScroll : Word;
begin
  with HPickListPtr(P)^ do begin
    case FramePos of
      frLL, frRR :   {Vertical scroll bar}
        {Let PickList handle it}
        hpSetScroll(FramePos, MPosX, MPosY, UserVal, P);
    else
      {Horizontal scroll bar}
      if Width < hpMaxCols then begin
        UserVal := TweakSlider(FramePos, MPosX, UserVal, 1);
        if UserVal <= 0 then
          nScroll := 0
        else if UserVal > hpMaxCols-Width then
          nScroll := hpMaxCols-Width
        else
          nScroll := UserVal;
        if nScroll <> hpScroll then begin
          hpScroll := nScroll;
          SetFlag(pkSecFlags, pkRedrawPage);
        end;
      end;
    end;
  end;
end;
{$ENDIF}

procedure NoPickString(Item : Word;
                       Mode : pkMode;
                       var IType : pkItemType;
                       var IString : String;
                       PickPtr : PickListPtr);
  {-Default user string proc must be overridden}
begin
  Abstract;
end;

procedure NoHPickString(Item : Word; Mode : pkMode; HScroll : Word;
                        var IType : pkItemType; var IString : String;
                        HPickPtr : HPickListPtr);
  {-Dummy string procedure used for HPickList derivatives}
begin
  Abstract;
end;
{$F-}

procedure HPickList.hpSetPrimMoves;
  {-Take over primitive move functions from PickList}
begin
  pkReinit := ReinitHPick;
  pkPrimMoves[LeftTop] := LeftAction;
  pkPrimMoves[LeftMiddle] := LeftAction;
  pkPrimMoves[LeftBottom] := LeftAction;
  pkPrimMoves[RightTop] := RightAction;
  pkPrimMoves[RightMiddle] := RightAction;
  pkPrimMoves[RightBottom] := RightAction;
  {$IFDEF UseScrollBars}
  pkUpdScrBar := UpdScrollHPick;
  hpSetScroll := pkSetScroll; {Save value to call}
  pkSetScroll := SetScrollHPick;
  {$ENDIF}
end;

constructor HPickList.Init(X1, Y1, X2, Y2 : Byte;
                           MaxItemWidth : Word;
                           NumItems : Word;
                           StringProc : hpStringProc;
                           CommandHandler : pkGenlProc);
  {-Initialize a pick window}
begin
  if not HPickList.InitDeluxe(X1, Y1, X2, Y2,
                              DefaultColorSet, DefWindowOptions,
                              MaxItemWidth, NumItems,
                              StringProc, CommandHandler, DefPickOptions) then
    Fail;
end;

constructor HPickList.InitCustom(X1, Y1, X2, Y2 : Byte;
                                 var Colors : ColorSet;
                                 Options : LongInt;
                                 MaxItemWidth : Word;
                                 NumItems : Word;
                                 StringProc : hpStringProc;
                                 CommandHandler : pkGenlProc);
  {-Initialize a pick window with custom window options}
begin
  if not HPickList.InitDeluxe(X1, Y1, X2, Y2,
                              Colors, Options,
                              MaxItemWidth, NumItems,
                              StringProc, CommandHandler, DefPickOptions) then
    Fail;
end;

constructor HPickList.InitAbstract(X1, Y1, X2, Y2 : Byte;
                                   var Colors : ColorSet;
                                   Options : LongInt;
                                   MaxItemWidth : Word;
                                   NumItems : Word;
                                   CommandHandler : pkGenlProc);
   {-Constructor to be called by derived types that override
     the ItemString method}
begin
  if not HPickList.InitDeluxe(X1, Y1, X2, Y2,
                              Colors, Options,
                              MaxItemWidth, NumItems,
                              NoHPickString,
                              CommandHandler, DefPickOptions) then
    Fail;
end;

constructor HPickList.InitDeluxe(X1, Y1, X2, Y2 : Byte;
                                 var Colors : ColorSet;
                                 Options : LongInt;
                                 MaxItemWidth : Word;
                                 NumItems : Word;
                                 StringProc : hpStringProc;
                                 CommandHandler : pkGenlProc;
                                 PickOptions : Word);
  {-Initialize a pick window with custom window and pick options}
begin
  hpScroll := 0;
  hpString := StringProc;
  hpMaxCols := MaxItemWidth;
  if not PickList.InitDeluxe(X1, Y1, X2, Y2,
                             Colors, Options,
                             X2-X1+1, NumItems,
                             NoPickString, PickVertical,
                             CommandHandler, PickOptions) then
    Fail;

  {Take over some primitive move functions from pick list}
  hpSetPrimMoves;

end;

constructor HPickList.InitAbstractDeluxe(X1, Y1, X2, Y2 : Byte;
                                         var Colors : ColorSet;
                                         Options : LongInt;
                                         MaxItemWidth : Word;
                                         NumItems : Word;
                                         CommandHandler : pkGenlProc;
                                         PickOptions : Word);
   {-Constructor to be called by derived types that override the
     HItemString method, with custom pick options}
begin
  if not HPickList.InitDeluxe(X1, Y1, X2, Y2,
                              Colors, Options,
                              MaxItemWidth, NumItems,
                              NoHPickString,
                              CommandHandler, PickOptions) then
    Fail;
end;

function HPickList.GetCurrentCol : Word;
  {-Get column currently displayed at left edge of window}
begin
  GetCurrentCol := hpScroll+1;
end;

function HPickList.GetMaxWidth : Word;
  {-Get the maximum number of columns in any string}
begin
  GetMaxWidth := hpMaxCols;
end;

procedure HPickList.SetMaxWidth(MaxItemWidth : Word);
  {-Change the maximum number of columns in any string}
begin
  hpMaxCols := MaxItemWidth;
end;

procedure HPickList.ItemString(Item : Word; Mode : pkMode;
                               var IType : pkItemType;
                               var IString : String);
  {-Overrides PickList.ItemString}
begin
  HItemString(Item, Mode, hpScroll, IType, IString);
end;

procedure HPickList.HItemString(Item : Word;
                                Mode : pkMode;
                                HScroll : Word;    {Horizontal scroll offset}
                                var IType : pkItemType;
                                var IString : String);
  {-Returns item string}
begin
  hpString(Item, Mode, HScroll, IType, IString, @Self);
end;

{$IFDEF UseAdjustableWindows}
procedure HPickList.AdjustWindow(X1, Y1, X2, Y2 : Word);
begin
  {Always treat each item as full window width}
  pkItemWidth := X2-X1+1;
  pkReqdWidth := pkItemWidth;

  {Adjust scroll if needed}
  if hpMaxCols-hpScroll < pkItemWidth then begin
    if hpMaxCols < pkItemWidth then
      hpScroll := 0
    else
      hpScroll := hpMaxCols-pkItemWidth;
  end;

  PickList.AdjustWindow(X1, Y1, X2, Y2);

  {In case of error}
  pkItemWidth := Width;
  pkReqdWidth := pkItemWidth;
end;
{$ENDIF}


{$IFDEF UseStreams}
constructor HPickList.Load(var S : IdStream);
  {-Load a pick list from a stream}
begin
  {Load the underlying pick list}
  if not PickList.Load(S) then
    Fail;

  {Read data specific to the h-pick list}
  S.ReadRange(hpScroll, hpString);

  {Read the user routine}
  @hpString := S.ReadUserPointer(@NoHPickString);

  if S.PeekStatus <> 0 then begin
    Done;
    Fail;
  end;

  {Take over primitive move functions}
  hpSetPrimMoves;
end;

procedure HPickList.Store(var S : IdStream);
  {-Store a pick list in a stream}
begin
  {Store the underlying pick list}
  PickList.Store(S);
  if S.PeekStatus <> 0 then
    Exit;

  {Write data specific to the h-pick list}
  S.WriteRange(hpScroll, hpString);

  {Write the user-provided routine}
  S.WriteUserPointer(@hpString, ptNoHPickString);
end;

procedure HPickListStream(SPtr : IdStreamPtr);
  {-Register all types needed for streams containing h-pick lists}
begin
  PickListStream(SPtr);
  with SPtr^ do begin
    RegisterType(otHPickList, veHPickList, TypeOf(HPickList),
                 @HPickList.Store, @HPickList.Load);
    RegisterPointer(ptNoHPickString, @NoHPickString);
    RegisterPointer(ptPickVertical, @PickVertical);
  end;
end;
{$ENDIF}

{$IFDEF InitAllUnits}
begin
{$ENDIF}
end.