home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 1998 January / Pcwk0198.iso / Dcomplib / BTNARRAY.LZH / BUTARRAY.PAS next >
Pascal/Delphi Source File  |  1995-07-13  |  19KB  |  532 lines
  1. unit ButArray;
  2. (*
  3.    Description
  4.  
  5.    Base Class to create an array of buttons using (TButton) like DB Navigator
  6.    The Variables are: Button Width, Height, No of Buttons  and
  7.    Spacing between buttons
  8.  
  9.    The button height and width and Spacing is fixed in the object editor
  10.    and can not be changed using the mouse.
  11.  
  12.    The Button Count by default is 1, to increase the number of buttons
  13.    expand the width of the control using a mouse or change the value in the
  14.    object editor
  15.  
  16.    To Add Button Caption and Hints to each button either use the string property
  17.    or use a resource string table.
  18.  
  19.    For the second option you need a resource workshop like in Borland C++ 4
  20.    When using a string table just pass the first resource ID it is assumed
  21.    that subsequent button text will be the next number ID a long.
  22.  
  23.    To capture event
  24.      Each button has an index number starting from 0 to N
  25.      the LHB (Left hand Button) is 0
  26.      This index number is passed when the event is captured by the user
  27.  
  28.    inheritance
  29.      To creating a new object from this class is easier than using
  30.      DBNavigator all the Events have virtual procedural calls, this may be
  31.      overriden and new functionality added
  32.  
  33.      An example of database navigator buttons using this class see ClinNav
  34.  
  35.      Author Mike Lindre CompuServe USERID 100567,2225
  36.  
  37.      Last Edit 12 July 1995
  38.  
  39.     *)
  40.  
  41.  
  42. interface
  43.  
  44. uses
  45.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  46.   Forms, Dialogs,StdCtrls;
  47.  
  48.   {Set the constanst to be used}
  49. const DF_BUT_WIDTH = 67;  {Height of the buttons}
  50.       DF_BUT_HEIGHT = 22; {Width of the buttons}
  51.       DF_BUT_SPACE = -1;  {Space between each button}
  52.       DF_NO_OF_BUT = 1;   {No of buttons on creation of component}
  53.       DF_NOT_USED = 0;    {Are the resources used or not}
  54. type
  55.   {Create new events with a button index (0...N) so that each button
  56.    in the group may be used effectively}
  57.   EButClick     = procedure (Sender:TObject;ButtonIndex:integer) of object;
  58.   EButEnter     = procedure (Sender: TObject;ButtonIndex:integer)of object;
  59.   EButExit      = procedure (Sender: TObject;ButtonIndex:integer)of object;
  60.   EButKeyDown   = procedure (Sender: TObject;ButtonIndex:integer;var Key: Word;
  61.                             Shift: TShiftState)of object;
  62.   EButKeyPress  = procedure (Sender: TObject;ButtonIndex:integer;
  63.                             var Key: Char)of object;
  64.   EButKeyUp     = procedure (Sender: TObject;ButtonIndex:integer; var Key: Word;
  65.                             Shift: TShiftState) of object;
  66.   EButMouseDown = procedure (Sender: TObject ;ButtonIndex:integer ;
  67.            Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
  68.   EButMouseMove = procedure (Sender: TObject ;ButtonIndex:integer ;
  69.            Shift: TShiftState; X,Y: Integer) of object;
  70.   EButMouseUp   = procedure (Sender: TObject ;ButtonIndex:integer;
  71.            Button: TMouseButton; Shift: TShiftState; X, Y: Integer) of object;
  72.  
  73.   TButtonArray = class(TWinControl)
  74.   private
  75.     { Private declarations }
  76.     FNoOFButtons:integer; {No of buttons}
  77.     FHints:TStrings;      {Hints to be used}
  78.     FNames:TStrings;      {Names for the buttons}
  79.     FButtonWidth:integer; {Width of the buttons}
  80.     FButtonHeight:integer;{Height of the buttons}
  81.     FButtonSpace:integer; {Space between each button default = -1}
  82.     FNameResource:integer;{Resource number if names are stored in res file}
  83.     FHintResource:integer;{Resource number if hints are stored in res file}
  84.     ButtonList:TList;     {List of button objects}
  85.     CurrentControlWidth:integer;
  86.     {properties for the new events}
  87.     FOnButClick:EButClick;
  88.     FOnButEnter:EButEnter;
  89.     FOnButExit:EButExit;
  90.     FOnButKeyDown:EButKeyDown;
  91.     FOnButKeyPress:EButKeyPress;
  92.     FOnButKeyUp:EButKeyUp;
  93.     FOnButMouseDown:EButMouseDown;
  94.     FOnButMouseMove:EButMouseMove;
  95.     FOnButMouseUp:EButMouseUp;
  96.  
  97.     {General functions}
  98.     procedure SetUpButtons; {Create button(s) and place them in the list}
  99.     procedure UpdateSize;   {Change the size of the buttons in the control}
  100.     procedure SetUpHints;   {Assign buttons with hint help}
  101.     procedure SetUpNames;   {Assign button with Captions}
  102.     procedure ClearList;    {Remove anything from the button list}
  103.  
  104.     {property function used when setting properties}
  105.     procedure SetHints(Value:TStrings);
  106.     procedure SetNames(Value:TStrings);
  107.     procedure SetNoOFButtons(Value:integer);
  108.     procedure SetButtonWidth(Value:integer);
  109.     procedure SetButtonHeight(Value:integer);
  110.     procedure SetButtonSpace(Value :integer);
  111.     procedure SetNameResource(Value:integer);
  112.     procedure SetHintResource(Value:integer);
  113.  
  114.     {Function definitons that replicate the events for a standard button
  115.      These will be assigned to each of the buttons in a list, and will
  116.      capture all the events made by the buttons.
  117.  
  118.      Once the event is captured it will be reassigned to the new event
  119.      handler for this component with the approprate button index set}
  120.     procedure Click(Sender:TObject);
  121.     procedure Enter(Sender: TObject);
  122.     procedure Exit(Sender: TObject);
  123.     procedure KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
  124.     procedure KeyPress(Sender: TObject; var Key: Char);
  125.     procedure KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
  126.     procedure MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  127.     procedure MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  128.     procedure MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  129.  
  130.     { When a wm size message is sent handle it properly}
  131.     procedure WMSize(var Message:TWMSize); message WM_SIZE;
  132.   protected
  133.     {Set the approprate buttons to enable etc}
  134.     procedure EnableButtons(const A:array of Boolean);
  135.  
  136.     {These are virtual functions using the dynamic calling convention
  137.      These are used as place holders for new components
  138.      These functions may be overriden in new components as long as the
  139.      new versions calls the inhertied ones so it keep this basic functionality.
  140.  
  141.      Using dynamic to keep memory usage low and, it appears that if a function
  142.      is called a lot like a message then this dispatch method is then used;
  143.  
  144.      Only when speed is very important that one should use the virtual keyword
  145.  
  146.      When the standard events are called from each button, it is redirected
  147.      to one of the below functions, from where it is processed.
  148.      (It checks to see if any of the new events have been assigned)}
  149.  
  150.     procedure ButClick(ButtonIndex:integer);  dynamic;
  151.     procedure ButEnter (ButtonIndex:integer); dynamic;
  152.     procedure ButExit(ButtonIndex:integer);   dynamic;
  153.     procedure ButKeyDown(ButtonIndex:integer;var Key: Word;Shift: TShiftState);dynamic;
  154.     procedure ButKeyPress(ButtonIndex:integer;var Key: Char);dynamic;
  155.     procedure ButKeyUp (ButtonIndex:integer; var Key: Word;Shift: TShiftState);dynamic;
  156.     procedure ButMouseDown(ButtonIndex:integer;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);dynamic;
  157.     procedure ButMouseMove(ButtonIndex:integer;Shift: TShiftState; X,Y: Integer);dynamic;
  158.     procedure ButMouseUp (ButtonIndex:integer;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);dynamic;
  159.         { Protected declarations }
  160.   public
  161.     { Public declarations }
  162.     constructor Create(AOwner: TComponent); override;
  163.     destructor Destroy; override;
  164.     {define the resource numbers for names and string}
  165.     property NameResource:integer read FNameResource write SetNameResource;
  166.     property HintResource:integer read FHintResource write SetHintResource;
  167.   published
  168.     { Published declarations }
  169.     property Enabled;
  170.     property Visible;
  171.     property ShowHint;
  172.     property ParentShowHint;
  173.     property Font;
  174.     property TabOrder;
  175.     property TabStop;
  176.     property Hints:TStrings read FHints write SetHints;
  177.     property Names:TStrings read FNames write SetNames;
  178.     property NoOfButtons:integer read FNoOFButtons write SetNoOFButtons default DF_NO_OF_BUT;
  179.     property ButtonWidth:integer read FButtonWidth write SetButtonWidth default DF_BUT_WIDTH;
  180.     property ButtonHeight:integer read FButtonHeight write SetButtonHeight default DF_BUT_HEIGHT;
  181.     property ButtonSpace :integer read FButtonSpace  write SetButtonSpace  default DF_BUT_SPACE;
  182.     {Add properties for the new events that may be used by the component user}
  183.     property OnClick:EButClick read FOnButClick write FOnButClick;
  184.     property OnEnter:EButEnter read FOnButEnter write FOnButEnter;
  185.     property OnExit: EButExit  read FOnButExit  write FOnButExit;
  186.     property OnKeyDown:EButKeyDown read FOnButKeyDown write FOnButKeyDown;
  187.     property OnKeyPress:EButKeyPress read FOnButKeyPress write FOnButKeyPress;
  188.     property OnKeyUp:EButKeyUp read FOnButKeyUp write FOnButKeyUp;
  189.     property OnMouseDown:EButMouseDown read FOnButMouseDown write FOnButMouseDown;
  190.     property OnMouseMove:EButMouseMove read FOnButMouseMove write FOnButMouseMove;
  191.     property OnMouseUp: EButMouseUp read FOnButMouseUp write FOnButMouseUp;
  192.   end;
  193.  
  194. implementation
  195.  
  196. constructor TButtonArray.Create(AOwner: TComponent);
  197. begin
  198.   inherited Create(AOwner);
  199.   {Set the defaults for the button height and width and number of}
  200.   FButtonWidth   := DF_BUT_WIDTH;
  201.   FButtonHeight := DF_BUT_HEIGHT;
  202.   FButtonSpace  := DF_BUT_SPACE;
  203.   FNoOFButtons  := DF_NO_OF_BUT;
  204.   FNameResource := DF_NOT_USED;
  205.   FHintREsource := DF_NOT_USED;
  206.   CurrentControlWidth := DF_BUT_WIDTH;
  207.   Visible := True;
  208.   {Create the lists for the names and helpful hints}
  209.   FHints := TStringList.Create;
  210.   FNames := TStringList.Create;
  211.   {Create the buttons}
  212.   SetUpButtons;
  213. end;
  214.  
  215. destructor TButtonArray.Destroy;
  216. begin
  217.   ClearList;
  218.   inherited Destroy;
  219. end;
  220.  
  221. procedure TButtonArray.SetNameResource(Value:integer);
  222. begin
  223.   if Value <= 0 then Value := 0;
  224.   FNameResource := Value;
  225.   SetUpNames;
  226. end;
  227.  
  228. procedure TButtonArray.SetHintResource(Value:integer);
  229. begin
  230.   if Value <= 0 then Value := 0;
  231.   FHintResource := Value;
  232.   SetUpHints;
  233. end;
  234.  
  235.  
  236. procedure TButtonArray.ClearList;
  237. {Each time SetupButtons is Called this function
  238.  destroys the list ready to be recreated}
  239. var  Bnt:TButton;
  240. begin
  241.   while ButtonList <> nil do begin
  242.     Bnt:= TButton(ButtonList.Last);
  243.     ButtonList.Remove(Bnt);
  244.     if ButtonList.Count = 0 then
  245.       begin
  246.         ButtonList.Free;
  247.         ButtonList := nil;
  248.       end;
  249.     Bnt.Destroy;
  250.   end;
  251. end;
  252.  
  253. procedure TButtonArray.SetUpButtons;
  254. var Counter:integer;
  255.     Space:integer;
  256.     Bnt:TButton;
  257. begin
  258.    {Distroy the current list}
  259.    ClearList;
  260.    {Make a new list}
  261.    ButtonList := TList.Create;
  262.    ButtonList.Capacity := FNoOFButtons;
  263.    Space := 0;
  264.    {Add the buttons as required}
  265.    for Counter := 0 to FNoOFButtons-1 do begin
  266.      Bnt:= TButton.Create(Self);
  267.      {Set the size of each button}
  268.      Bnt.SetBounds (Counter * (FButtonWidth+Space), 0, FButtonWidth, FButtonHeight);
  269.      Bnt.Parent:=Self;
  270.      Bnt.Enabled:= Enabled;
  271.      {The button tag proptery is used to identify the button as an index}
  272.      Bnt.Tag:=Counter;
  273.      {Assign the intermediate funtions to catch and process events for
  274.       each of the buttons}
  275.      Bnt.OnClick := Click;
  276.      Bnt.OnEnter := Enter;
  277.      Bnt.OnExit  := Exit;
  278.      Bnt.OnKeyDown  := KeyDown;
  279.      Bnt.OnKeyPress := KeyPress;
  280.      Bnt.OnKeyUp := KeyUp;
  281.      Bnt.OnMouseDown := MouseDown;
  282.      Bnt.OnMouseMove := MouseMove;
  283.      Bnt.OnMouseUp   := MouseUp;
  284.      {Add the button to the list}
  285.      ButtonList.Add(Bnt);
  286.      {set the space between each button}
  287.     Space := FButtonSpace;
  288.   end;
  289.   {Set the size for the complete control}
  290.   CurrentControlWidth := (FNoOFButtons * FButtonWidth) + (FNoOFButtons -1)*FButtonSpace;
  291.   inherited SetBounds(Left,Top,CurrentControlWidth,FButtonHeight);
  292.   {set the button captions and hints}
  293.   SetUpNames;
  294.   SetUpHints;
  295. end;
  296.  
  297. procedure TButtonArray.UpdateSize;
  298. var Counter:integer;
  299.     Space:integer;
  300. begin
  301.    Space := 0;
  302.    {Add the buttons as required}
  303.    for Counter := 0 to FNoOFButtons-1 do begin
  304.      {Set the size of each button}
  305.      TButton(ButtonList.Items[Counter]).SetBounds (Counter * (FButtonWidth+Space), 0, FButtonWidth, FButtonHeight);
  306.      {set the space between each button}
  307.     Space := FButtonSpace;
  308.   end;
  309.   {Set the size for the complete control}
  310.   CurrentControlWidth := (FNoOFButtons * FButtonWidth) + (FNoOFButtons -1)*FButtonSpace;
  311.   inherited SetBounds(Left,Top,CurrentControlWidth,FButtonHeight);
  312. end;
  313.  
  314. {The following functions are the intermedate ones that capture the
  315.  events from each button and redirect it to the new events}
  316.  
  317. procedure TButtonArray.Click(Sender:TObject);
  318. begin
  319.   ButClick(TButton(Sender).Tag);
  320. end;
  321.  
  322. procedure TButtonArray.ButClick(ButtonIndex:integer);
  323. begin
  324.   {If a user has assigned an event use it}
  325.   if not (csDesigning in ComponentState) and Assigned(FOnButClick) then
  326.      FOnButClick(Self,ButtonIndex);
  327. end;
  328.  
  329. procedure TButtonArray.Enter(Sender: TObject);
  330. begin
  331.   ButEnter(TButton(Sender).Tag);
  332. end;
  333.  
  334. procedure TButtonArray.ButEnter(ButtonIndex:integer);
  335. begin
  336.   if not (csDesigning in ComponentState) and Assigned(FOnButEnter) then
  337.      FOnButEnter(Self,ButtonIndex);
  338. end;
  339.  
  340. procedure TButtonArray.Exit(Sender: TObject);
  341. begin
  342.   ButExit(TButton(Sender).Tag);
  343. end;
  344.  
  345. procedure TButtonArray.ButExit(ButtonIndex:integer);
  346. begin
  347.   if not (csDesigning in ComponentState) and Assigned(FOnButExit) then
  348.      FOnButExit(Self,ButtonIndex);
  349. end;
  350.  
  351. procedure TButtonArray.KeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
  352. begin
  353.   ButKeyDown(TButton(Sender).Tag,Key,Shift);
  354. end;
  355.  
  356. procedure TButtonArray.ButKeyDown(ButtonIndex:integer;var Key: Word;Shift: TShiftState);
  357. begin
  358.   if not (csDesigning in ComponentState) and Assigned(FOnButKeyDown) then
  359.      FOnButKeyDown(Self,ButtonIndex,Key,Shift);
  360. end;
  361.  
  362. procedure TButtonArray.KeyPress(Sender: TObject; var Key: Char);
  363. begin
  364.   ButKeyPress(TButton(Sender).Tag,Key);
  365. end;
  366.  
  367. procedure TButtonArray.ButKeyPress(ButtonIndex:integer;var Key: Char);
  368. begin
  369.   if not (csDesigning in ComponentState) and Assigned(FOnButKeyPress) then
  370.      FOnButKeyPress(Self,ButtonIndex,Key);
  371. end;
  372.  
  373. procedure TButtonArray.KeyUp(Sender: TObject; var Key: Word;Shift: TShiftState);
  374. begin
  375.   ButKeyUp(TButton(Sender).Tag,Key,Shift);
  376. end;
  377.  
  378. procedure TButtonArray.ButKeyUp(ButtonIndex:integer; var Key: Word;Shift: TShiftState);
  379. begin
  380.   if not (csDesigning in ComponentState) and Assigned(FOnButKeyUp) then
  381.      FOnButKeyUp(Self,ButtonIndex,Key,Shift);
  382. end;
  383.  
  384. procedure TButtonArray.MouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  385. begin
  386.   ButMouseDown(TButton(Sender).Tag,Button,Shift,X,Y);
  387. end;
  388.  
  389. procedure TButtonArray.ButMouseDown(ButtonIndex:integer;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  390. begin
  391.   if not (csDesigning in ComponentState) and Assigned(FOnButMouseDown) then
  392.      FOnButMouseDown(Self,ButtonIndex,Button,Shift,X,Y);
  393. end;
  394.  
  395. procedure TButtonArray.MouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  396. begin
  397.   ButMouseMove(TButton(Sender).Tag,Shift,X,Y);
  398. end;
  399.  
  400. procedure TButtonArray.ButMouseMove(ButtonIndex:integer;Shift: TShiftState; X,Y: Integer);
  401. begin
  402.   if not (csDesigning in ComponentState) and Assigned(FOnButMouseMove) then
  403.      FOnButMouseMove(Self,ButtonIndex,Shift,X,Y);
  404. end;
  405.  
  406. procedure TButtonArray.MouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
  407. begin
  408.   ButMouseUp(TButton(Sender).Tag,Button,Shift,X, Y);
  409. end;
  410.  
  411. procedure TButtonArray.ButMouseUp(ButtonIndex:integer;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  412. begin
  413.   if not (csDesigning in ComponentState) and Assigned(FOnButClick) then
  414.      FOnButMouseUp(Self,ButtonIndex,Button,Shift,X, Y);
  415. end;
  416.  
  417. {set the enabled property on each button}
  418. {Always starting from the first button so some dummies might be needed}
  419. procedure TButtonArray.EnableButtons(const A:array of Boolean);
  420. var Counter:integer;
  421. begin
  422.   for Counter := 0 to  sizeof(A) - 1 do
  423.      TButton(ButtonList.Items[Counter]).Enabled := A[Counter];
  424. end;
  425.  
  426. {Set the captions for each button, check to see if the names are stored
  427.  in a resource file or a text file CAN be both}
  428. procedure TButtonArray.SetUpNames;
  429. var Counter:integer;
  430. begin
  431.   if FNameResource <> 0 then begin
  432.     for Counter := 0 to  FNoOFButtons - 1 do
  433.       TButton(ButtonList.Items[Counter]).Caption := loadstr(FNameResource + Counter);
  434.   end;
  435.   Counter := 0;
  436.   while (Counter < FNames.Count) and (Counter < FNoOFButtons) do begin
  437.     if FNames[Counter] <> '' then
  438.        TButton(ButtonList.Items[Counter]).Caption := FNames[Counter];
  439.     inc(Counter);
  440.   end;
  441. end;
  442.  
  443. {set the hints for each buttonm, check to see if the names are stored
  444.  in a resource file or a text file CAN be both}
  445. procedure TButtonArray.SetUpHints;
  446. var Counter:integer;
  447. begin
  448.   if FHintResource <> 0 then begin
  449.     for Counter := 0 to  FNoOFButtons - 1 do
  450.       TButton(ButtonList.Items[Counter]).Hint := loadstr(FHintResource + Counter);
  451.   end;
  452.   Counter := 0;
  453.   while (Counter < FHints.Count) and (Counter < FNoOFButtons) do begin
  454.     if FHints[Counter] <> '' then
  455.      TButton(ButtonList.Items[Counter]).Hint := FHints[Counter];
  456.     inc(Counter);
  457.   end;
  458. end;
  459.  
  460. {Assign properties functions}
  461. procedure TButtonArray.SetNames(Value:TStrings);
  462. begin
  463.    FNames.Assign(Value);
  464.    SetUpNames;
  465. end;
  466.  
  467. procedure TButtonArray.SetHints(Value:TStrings);
  468. begin
  469.    FHints.Assign(Value);
  470.    SetUpHints;
  471. end;
  472.  
  473. procedure TButtonArray.SetNoOFButtons(Value:integer);
  474. begin
  475.   {check the value has changed}
  476.   if FNoOFButtons <> Value then begin
  477.      FNoOFButtons := Value;
  478.      SetUpButtons;
  479.   end;
  480. end;
  481.  
  482. procedure TButtonArray.SetButtonWidth(Value:integer);
  483. begin
  484.   {check the value has changed}
  485.   if FButtonWidth <> Value then begin
  486.      FButtonWidth := Value;
  487.      UpdateSize;
  488.   end;
  489. end;
  490.  
  491. procedure TButtonArray.SetButtonHeight(Value:integer);
  492. begin
  493.   {check the value has changed}
  494.   if FButtonHeight <> Value then begin
  495.      FButtonHeight := Value;
  496.      UpdateSize;
  497.   end;
  498. end;
  499.  
  500. procedure TButtonArray.SetButtonSpace(Value:integer);
  501. begin
  502.   {Check that the value has changed}
  503.   if FButtonSpace <> Value then begin
  504.      FButtonSpace := Value;
  505.      UpdateSize;
  506.   end;
  507. end;
  508.  
  509. procedure TButtonArray.WMSize(var Message:TWMSize);
  510. var NewButtonCount:integer;
  511. begin
  512.   {Check the size has changed}
  513.   inherited; {Do default processing}
  514.   {When the controls size changes keep the button count appropriate}
  515.   NewButtonCount := round((Width-(FNoOfButtons-1)*FButtonSpace)/FButtonWidth);
  516.   if NewButtonCount <> FNoOFButtons then begin
  517.      FNoOFButtons := NewButtonCount;
  518.      if FNoOFButtons <= 0 then FNoOFButtons := 1;
  519.      SetUpButtons;
  520.   end;
  521.  
  522.   {Make sure that the control stays the same size as the buttons}
  523.   if (Width <> CurrentControlWidth) or (Height <> FButtonHeight) then
  524.       inherited SetBounds(Left,Top,CurrentControlWidth,FButtonHeight);
  525.  
  526.   {This message returns zero to tell the application
  527.    that this message has been processed}
  528.   Message.Result := 0;
  529. end;
  530.  
  531. end.
  532.