home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / Misc / Checkgrp.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-02  |  11KB  |  357 lines
  1. unit Checkgrp;
  2.  
  3. {$I Misc.inc}
  4.  
  5. {-----------------------------------------------------------------------------
  6. The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); you may not use this file except in compliance with the License. You may obtain a copy of the License at
  7.  
  8. http://www.mozilla.org/MPL/MPL-1.1.html
  9.  
  10. Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for the specific language governing rights and limitations under the License.
  11.  
  12. The Original Code is: CheckGroup.pas, released 12 September 2000.
  13.  
  14. The Initial Developer of the Original Code is Mat Ballard.
  15. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
  16. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
  17. All Rights Reserved.
  18.  
  19. Contributor(s): Mat Ballard                 email: mat.ballard@chemware.hypermart.net.
  20.                 Robert Ross                 email: rross@sigmaofficesolutions.com
  21.  
  22. Last Modified: 05/25/2000
  23. Current Version: 2.00
  24.  
  25. You may retrieve the latest version of this file from:
  26.  
  27.         http://Chemware.hypermart.net/
  28.  
  29. This work was created with the Project JEDI VCL guidelines:
  30.  
  31.         http://www.delphi-jedi.org/Jedi:VCLVCL
  32.  
  33. in mind. 
  34.  
  35.  
  36. Purpose:
  37. Multi-select radio group
  38.  
  39.  
  40. Known Issues:
  41. -----------------------------------------------------------------------------}
  42.  
  43. {$I Misc.inc}
  44.  
  45. interface
  46.  
  47. uses
  48.   Classes, SysUtils,
  49. {$IFDEF WINDOWS}
  50.   WinTypes, WinProcs,
  51.   Graphics, Messages, Stdctrls
  52. {$ENDIF}
  53. {$IFDEF WIN32}
  54.   Windows,
  55.   Graphics, Messages, Stdctrls
  56. {$ENDIF}
  57. {$IFDEF LINUX}
  58.   QT,
  59.   QGraphics, QStdctrls
  60. {$ENDIF}
  61.   ;
  62.  
  63. const
  64.   TCHECKGROUP_VERSION = 100;
  65.  
  66. type
  67.   TCheckBoxArray = array [0..1023] of TCheckBox;
  68.   pCheckBoxArray = ^TCheckBoxArray;
  69.  
  70.   TOnBoxClick = procedure(Sender: TObject; Tag: Integer) of object;
  71.  
  72.   TCheckGroup = class(TGroupBox)
  73.   private
  74.  { Private fields of TCheckGroup }
  75.  { Storage for property Items }
  76.     FItems : TStringList;
  77.     FNo_CheckBoxes: Integer;
  78.     FColumns: Byte;
  79.     FOnBoxClick: TOnBoxClick;
  80.  
  81.  { Private methods of TCheckGroup }
  82.     procedure SetColumns(Value : Byte);
  83.  
  84.  { Write method for property Items }
  85.     procedure SetItems(Value : TStringList);
  86.     {procedure CMFontChanged(var Message: TMessage);}
  87.     {procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;}
  88. {$IFDEF MSWINDOWS}
  89.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  90. {$ENDIF}
  91. {$IFDEF LINUX}
  92. {$ENDIF}
  93.   protected
  94.     {procedure WMPaint(var Message: TWMPaint); message WM_PAINT;)}
  95.     procedure DoBoxClick(Sender: TObject); virtual;
  96.     procedure Loaded; override;
  97.     procedure SetNoCheckBoxes(Value: Integer);
  98.  { This arranges the CheckBoxes on the panel }
  99.     Procedure OnItemsChange(Sender: TObject); virtual;
  100.   public
  101.  { A list of the CheckBoxes }
  102.     CheckBoxes: pCheckBoxArray;
  103.  
  104.  { Public methods of TCheckGroup }
  105.     constructor Create(AOwner: TComponent); override;
  106.     destructor Destroy; override;
  107.  { This sets the size of the CheckBoxes array, and creates the CheckBoxes }
  108.     procedure ArrangeCheckBoxes;
  109.  
  110.   published
  111.  { List of radio CheckBox names. The number of items sets the number o }
  112.     property Columns: Byte read FColumns write SetColumns;
  113.     property Items : TStringList read FItems write SetItems;
  114.     property OnBoxClick: TOnBoxClick read FOnBoxClick write FOnBoxClick;
  115.   end;
  116.  
  117. implementation
  118.  
  119. {------------------------------------------------------------------------------
  120.     Procedure: TCheckGroup.Create
  121.   Description: standard constructor
  122.        Author: Mat Ballard
  123.  Date created: 04/25/2000
  124. Date modified: 04/25/2000 by Mat Ballard
  125.       Purpose: initializes Properties
  126.  Known Issues:
  127.  ------------------------------------------------------------------------------}
  128. constructor TCheckGroup.Create(AOwner: TComponent);
  129. begin
  130. { Call the Create method of the container's parent class     }
  131.    inherited Create(AOwner);
  132.  
  133.    Width := 81;
  134.    Height := 217;
  135.    Font.Style := [fsBold];
  136.  
  137.    FColumns := 1;
  138.    FItems := TStringList.Create;
  139.    FItems.OnChange := OnItemsChange;
  140. end;
  141.  
  142. {------------------------------------------------------------------------------
  143.     Procedure: TCheckGroup.Destroy
  144.   Description: standard destructor
  145.        Author: Mat Ballard
  146.  Date created: 04/25/2000
  147. Date modified: 04/25/2000 by Mat Ballard
  148.       Purpose: frees the checkboxes
  149.  Known Issues:
  150.  ------------------------------------------------------------------------------}
  151. destructor TCheckGroup.Destroy;
  152. begin
  153.    FItems.Free;
  154.    SetNoCheckBoxes(0);
  155.  
  156. { Last, free the component by calling the Destroy method of the  }
  157. { parent class.                          }
  158.    inherited Destroy;
  159. end;
  160.  
  161. {------------------------------------------------------------------------------
  162.     Procedure: TCheckGroup.DoBoxClick
  163.   Description: responds to a click event of a single checkbox
  164.        Author: Mat Ballard
  165.  Suggested by: Robert Ross
  166.  Date created: 11/27/2000
  167. Date modified: 11/27/2000 by Mat Ballard
  168.       Purpose: overrides the ancestor
  169.  Known Issues:
  170.  ------------------------------------------------------------------------------}
  171. procedure TCheckGroup.DoBoxClick(Sender: TObject);
  172. begin
  173.   if Assigned(FOnBoxClick) then
  174.     OnBoxClick(Self, TCheckBox(Sender).Tag);
  175. end;
  176.  
  177. {------------------------------------------------------------------------------
  178.     Procedure: TCheckGroup.Loaded
  179.   Description: responds to a load event
  180.        Author: Mat Ballard
  181.  Date created: 04/25/2000
  182. Date modified: 04/25/2000 by Mat Ballard
  183.       Purpose: overrides the ancestor
  184.  Known Issues:
  185.  ------------------------------------------------------------------------------}
  186. procedure TCheckGroup.Loaded;
  187. begin
  188.   SetNoCheckBoxes(FItems.Count);
  189.   ArrangeCheckBoxes;
  190. end;
  191.  
  192. {------------------------------------------------------------------------------
  193.     Procedure: TCheckGroup.SetItems
  194.   Description: standard property Set procedure
  195.        Author: Mat Ballard
  196.  Date created: 04/25/2000
  197. Date modified: 04/25/2000 by Mat Ballard
  198.       Purpose: sets the Items Property
  199.  Known Issues: if the Items are changed programmatically, then
  200.                the above routine is bypassed.
  201.  ------------------------------------------------------------------------------}
  202. procedure TCheckGroup.SetItems(Value : TStringList);
  203. begin
  204. { Use Assign method because TStrings is an object type }
  205.   FItems.Assign(Value);
  206.  
  207.   SetNoCheckBoxes(FItems.Count);
  208. { If changing this property affects the appearance of
  209.      the component, call Invalidate here so the image will be
  210.      updated. }
  211.   Invalidate;
  212.   ArrangeCheckBoxes;
  213. end;
  214.  
  215. {------------------------------------------------------------------------------
  216.     Procedure: TCheckGroup.OnItemsChange
  217.   Description: standard change event handler for Items
  218.        Author: Mat Ballard
  219.  Date created: 04/25/2000
  220. Date modified: 04/25/2000 by Mat Ballard
  221.       Purpose: rearranges the checkboxes
  222.  Known Issues:
  223.  ------------------------------------------------------------------------------}
  224. Procedure TCheckGroup.OnItemsChange(Sender: TObject);
  225. begin
  226.   SetNoCheckBoxes(FItems.Count);
  227.   Invalidate;
  228.   ArrangeCheckBoxes;
  229. end;
  230.  
  231. procedure TCheckGroup.SetColumns(Value : Byte);
  232. begin
  233.   if (Value = 0) then Value := 1;
  234.   FColumns := Value;
  235.   ArrangeCheckBoxes;
  236. end;
  237.  
  238. {------------------------------------------------------------------------------
  239.     Procedure: TCheckGroup.SetNoCheckBoxes
  240.   Description: standard property Set procedure
  241.        Author: Mat Ballard
  242.  Date created: 04/25/2000
  243. Date modified: 04/25/2000 by Mat Ballard
  244.       Purpose: This sets the size of the CheckBoxes array, and creates the CheckBoxes
  245.  Known Issues:
  246.  ------------------------------------------------------------------------------}
  247. procedure TCheckGroup.SetNoCheckBoxes(Value: Integer);
  248. var
  249.   i: Integer;
  250. begin
  251.   for i := 0 to FNo_CheckBoxes-1 do
  252.   begin
  253.     CheckBoxes^[i].Free;
  254.   end;
  255.  
  256.   if (Value > 0) then
  257.   begin
  258.     CheckBoxes := AllocMem(Value*SizeOf(TCheckBox));
  259.   end
  260.   else
  261.   begin
  262.     FreeMem(CheckBoxes,
  263.             FNo_CheckBoxes*SizeOf(TCheckBox));
  264.     CheckBoxes := nil;
  265.   end;
  266.  
  267.   FNo_CheckBoxes := Value;
  268.  
  269. {create the CheckBoxes:}
  270.   for i := 0 to FNo_CheckBoxes-1 do
  271.   begin
  272.     CheckBoxes^[i] := TCheckBox.Create(Self);
  273.     CheckBoxes^[i].Parent := Self;
  274.     CheckBoxes^[i].Caption := FItems.Strings[i];
  275. {Robert Ross suggests:}
  276.     CheckBoxes^[i].Tag := i;
  277.     CheckBoxes^[i].OnClick := DoBoxClick;
  278.   end;
  279. end;
  280.  
  281. {------------------------------------------------------------------------------
  282.     Procedure: TCheckGroup.ArrangeCheckBoxes
  283.   Description: This arranges the CheckBoxes on the panel
  284.        Author: Mat Ballard
  285.  Date created: 04/25/2000
  286. Date modified: 04/25/2000 by Mat Ballard
  287.       Purpose: Display management
  288.  Known Issues:
  289.  ------------------------------------------------------------------------------}
  290. procedure TCheckGroup.ArrangeCheckBoxes;
  291. var
  292.   i,
  293.   NoRows,
  294.   TheTop,
  295.   TheLeft,
  296.   TheWidth,
  297.   TheGap,
  298.   DeltaHeight: Integer;
  299. begin
  300.   if (FNo_CheckBoxes > 0) then
  301.   begin
  302. {position the CheckBoxes:}
  303.     TheTop := 24;
  304.     TheLeft := 8;
  305.     TheGap := 12;
  306.     TheWidth := Width - (FColumns+1)*TheLeft - 2;
  307.     TheWidth := TheWidth div FColumns;
  308.     NoRows := FNo_CheckBoxes div FColumns;
  309.     if ((NoRows * FColumns) < FNo_CheckBoxes) then
  310.       Inc(NoRows);
  311.     DeltaHeight := (Height - TheTop) div NoRows;
  312.  
  313.     for i := 0 to FNo_CheckBoxes-1 do
  314.     begin
  315.       CheckBoxes^[i].Top := TheTop + (i div FColumns)*DeltaHeight;
  316.       CheckBoxes^[i].Left := TheLeft + (TheWidth + TheGap) * (i Mod FColumns);
  317.       CheckBoxes^[i].Width := TheWidth;
  318.       CheckBoxes^[i].Visible := TRUE;
  319.       CheckBoxes^[i].Invalidate;
  320.     end;
  321.   end;
  322. end;
  323.  
  324. {------------------------------------------------------------------------------
  325.     Procedure: TCheckGroup.WMSize
  326.   Description: standard ReSize message handler
  327.        Author: Mat Ballard
  328.  Date created: 04/25/2000
  329. Date modified: 04/25/2000 by Mat Ballard
  330.       Purpose: Re-Arranges the CheckBoxes
  331.  Known Issues:
  332.  ------------------------------------------------------------------------------}
  333. {$IFDEF MSWINDOWS}
  334. procedure TCheckGroup.WMSize(var Message: TMessage);
  335. begin
  336.   inherited;
  337.   ArrangeCheckBoxes;
  338. end;
  339. {$ENDIF}
  340.  
  341. {procedure TCheckGroup.CMFontChanged(var Message: TMessage);
  342. begin
  343.   inherited;
  344.   ArrangeCheckBoxes;
  345. end;}
  346.  
  347. {procedure TCheckGroup.WMPaint(var Message: TWMPaint);
  348. var
  349.   i: Integer;
  350. begin
  351.   inherited;
  352.   Broadcast(Message);
  353. end;}
  354.  
  355. end.
  356.  
  357.