PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/combox.exe/COMBO.PAS

Pascal/Delphi Source File | 1992-12-24 | 7.6 KB | 313 lines

Unit Combo;
interface
uses Views, Objects, Drivers, Dialogs, StdDlg, Dos;
{
  Author: Keith Greer
          68 Tamworth Rd.
          Troy, OH  45373-1551

  C'Serve ID: 73457,3042
    Internet: [e-mail]

  This unit defines a "combo box" pull down selection list ala Windows.
  The combo box looks and works similar to the history list. The
  difference is, the history window only contains a limited number of
  strings you have previously typed in the linked input line, whereas
  the combo box displays a sorted collection and supports "power
  typing" like TFileDialog.

}

const
  cmOkNext = 2200;

type

  {TComboCollection}

  PComboCollection = ^TComboCollection;
  TComboCollection = object(TSortedCollection)
    function TxtPtr(Item : integer) : String; virtual;
  end;

  {TComboListBox}

  PComboListBox = ^TComboListBox;
  TComboListBox = object(TSortedListBox)
    constructor Init(var Bounds : TRect; ANumCols : word;
                     AScrollBar : PScrollBar);
    procedure HandleEvent(var Event : TEvent); virtual;
    procedure FocusItem(Item: Integer); virtual;
    function GetText(Item: Integer; MaxLen: Integer): String; virtual;
    function GetPalette : PPalette; virtual;
  end;

  {TComboWindow}

  PComboWindow = ^TComboWindow;
  TComboWindow = object(TWindow)
    SelText : string;
    constructor Init(var Bounds : TRect; ListPtr : PComboCollection);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream);
    procedure HandleEvent(var Event : TEvent); virtual;
    function GetPalette : PPalette; virtual;
  end;

  {TComboBox}

  PComboBox = ^TComboBox;
  TComboBox = object(TView)
    ILine        : PInputLine;
    List         : PComboCollection;
    ILineFocused : Boolean;

    constructor Init(var Bounds : TRect; LinePtr : PInputLine;
                     ListPtr : PComboCollection);
    constructor Load(var S : TStream);
    procedure Store(var S : TStream);
    procedure Draw; virtual;
    procedure HandleEvent(var Event : TEvent); virtual;
    function GetPalette: PPalette; virtual;
  end;

  procedure RegisterCombo;

const
  RComboCollection : TStreamRec = (
    ObjType : 1000;
    VmtLink : Ofs(TypeOf(TComboCollection)^);
    Load    : @TComboCollection.Load;
    Store   : @TComboCollection.Store
  );

  RComboListBox : TStreamRec = (
    ObjType : 1001;
    VmtLink : Ofs(TypeOf(TComboListBox)^);
    Load    : @TComboListBox.Load;
    Store   : @TComboListBox.Store
  );

  RComboWindow : TStreamRec = (
    ObjType : 1002;
    VmtLink : Ofs(TypeOf(TComboWindow)^);
    Load    : @TComboWindow.Load;
    Store   : @TComboWindow.Store
  );

  RComboBox : TStreamRec = (
    ObjType : 1003;
    VmtLink : Ofs(TypeOf(TComboBox)^);
    Load    : @TComboBox.Load;
    Store   : @TComboBox.Store
  );


implementation

{TComboCollection}
function TComboCollection.TxtPtr;
begin
  TxtPtr := String(At(Item)^);
end;


{TComboListBox}
constructor TComboListBox.Init(var Bounds : TRect; ANumCols : word;
                 AScrollBar : PScrollBar);
begin
  TSortedListBox.Init(Bounds, ANumCols, AScrollBar);
end;

procedure TComboListBox.FocusItem(Item: Integer);
begin
  TSortedListbox.FocusItem(Item);
  if Owner <> nil then
  PComboWindow(Owner)^.SelText := PComboCollection(List)^.TxtPtr(Item);
end;

function TComboListBox.GetText;
var
  S : string;
begin
  if List <> nil then
  S := PComboCollection(List)^.TxtPtr(Item);
  if Length(S) > MaxLen then S[0] := Char(MaxLen);
  GetText := S;
end;

procedure TComboListBox.HandleEvent;
begin
  if List=nil then exit;
  if ((Event.What = evMouseDown) and (Event.Double)) or
     ((Event.What = evKeyDown) and (Event.KeyCode = kbEnter)) then
  begin
    Event.What := evCommand;
    Event.Command := cmOK;
    PutEvent(Event);
    ClearEvent(Event);
  end
  else if ((Event.What = evKeyDown) and (Event.KeyCode = kbTab)) then
  begin
    Event.What := evCommand;
    Event.Command := cmOkNext;
    PutEvent(Event);
    ClearEvent(Event);
  end
  else TSortedListBox.HandleEvent(Event);
end;

function TComboListBox.GetPalette : PPalette;
const
  P : string[Length(CHistoryViewer)] = CHistoryViewer;
begin
  GetPalette := @P;
end;

{TComboWindow}

constructor TComboWindow.Init;
var
  sbPtr : PScrollBar;
  R : TRect;
  B : PComboListBox;
begin
  TWindow.Init(Bounds, '', wnNoNumber);
  GetExtent(R); R.Grow(-1,-1);
  Flags := Flags and not (wfGrow + wfMove + wfZoom);
  if ListPtr<>nil then
  begin
    sbPtr := StandardScrollBar(sbVertical);
    B := New(PComboListBox, Init(R,1, sbPtr));
    B^.NewList(ListPtr);
    Insert(B);
    B^.FocusItem(0);
  end;
end;

constructor TComboWindow.Load(var S : TStream);
begin
  TWindow.Load(S);
  S.Read(SelText, SizeOf(string));
end;

procedure TComboWindow.Store(var S : TStream);
begin
  TWindow.Store(S);
  S.Write(SelText, SizeOf(string));
end;


function TComboWindow.GetPalette : PPalette;
const
  P : string[Length(CHistoryWindow)] = CHistoryWindow;
begin
  GetPalette := @P;
end;

procedure TComboWindow.HandleEvent;
begin
  if ((Event.What = evKeyDown) and (Event.KeyCode = kbEsc)) or
     ((Event.What = evMouseDown) and (Event.Buttons = mbRightButton)) then
  begin
    Event.What := evCommand;
    Event.Command := cmCancel;
  end;
  if (Event.What = evCommand) then
  case Event.Command of
    cmOK, cmCancel,cmOkNext :  EndModal(Event.Command);
  end;
  TWindow.HandleEvent(Event);
end;

{TComboBox}

constructor TComboBox.Init;
begin
  if (LinePtr=nil) or (ListPtr=nil) then Fail;
  TView.Init(Bounds);
  Options := Options or ofPostProcess;
  EventMask := EventMask or evBroadcast;
  ILine := LinePtr;
  List := ListPtr;
end;

constructor TComboBox.Load(var S : TStream);
begin
  TView.Load(S);
  GetPeerViewPtr(S, ILine);
  List := PComboCollection(S.Get);
  S.Read(ILineFocused, SizeOf(boolean));
end;

procedure TComboBox.Store(var S : TStream);
begin
  TView.Store(S);
  PutPeerViewPtr(S, ILine);
  S.Put(List);
  S.Write(ILineFocused, SizeOf(boolean));
end;


procedure TComboBox.HandleEvent;
var
  R,Extent : TRect;
  W        : PComboWindow;
  Control  : integer;
begin
  if (Event.What = evBroadcast) and (PInputLine(Event.InfoPtr) = ILine) then
  begin
    case Event.Command of
      cmReceivedFocus : ILineFocused := True;
      cmReleasedFocus : ILineFocused := False;
    end;
    ClearEvent(Event);
  end;

  if (Event.What = evMouseDown) or ((Event.What = evKeyDown) and
     (Event.KeyCode = kbDown) and ILineFocused) and (List^.Count>0) then
  begin
    if not ILineFocused then ILine^.Select;
    Owner^.GetExtent(Extent);
    ILine^.GetBounds(R); R.Grow(1,1); R.B.Y := Extent.B.Y - 1;
    if List^.Count < (R.B.Y - R.A.Y - 1) then
      R.B.Y := R.A.Y + List^.Count + 2;
    W := New(PComboWindow, Init(R, List));
    Control := Owner^.ExecView(W);
    if Control <> cmCancel then
    begin
      ILine^.Data^ := W^.SelText;
      ILine^.SelectAll(False);
      ILine^.DrawView;
    end;
    Dispose(W,Done);
    if Control = cmOkNext then Owner^.SelectNext(False);
    ClearEvent(Event);
  end
  else TView.HandleEvent(Event);
end;

function TComboBox.GetPalette : PPalette;
const
  P : string[Length(CHistory)] = CHistory;
begin
  GetPalette := @P;
end;

procedure TComboBox.Draw;
begin
  WriteChar(0,0,#222,2,1);
  WriteChar(1,0,#25,1,1);
  WriteChar(2,0,#221,2,1);
end;

procedure RegisterCombo;
begin
  RegisterType(RComboCollection);
  RegisterType(RComboListBox);
  RegisterType(RComboWindow);
  RegisterType(RComboBox);
end;

end. {Combo}