Chip 2001 October/Chip_2001-10_cd1.bin/zkuste/delphi/kompon/d123456/CHEMPLOT.ZIP/Misc/Checkgrp.pas

Pascal/Delphi Source File | 2001-05-02 | 10.5 KB | 357 lines

unit Checkgrp;

{$I Misc.inc}

{-----------------------------------------------------------------------------
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

http://www.mozilla.org/MPL/MPL-1.1.html

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.

The Original Code is: CheckGroup.pas, released 12 September 2000.

The Initial Developer of the Original Code is Mat Ballard.
Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
All Rights Reserved.

Contributor(s): Mat Ballard                 email: [e-mail].
                Robert Ross                 email: [e-mail]

Last Modified: 05/25/2000
Current Version: 2.00

You may retrieve the latest version of this file from:

        http://Chemware.hypermart.net/

This work was created with the Project JEDI VCL guidelines:

        http://www.delphi-jedi.org/Jedi:VCLVCL

in mind.


Purpose:
Multi-select radio group


Known Issues:
-----------------------------------------------------------------------------}

{$I Misc.inc}

interface

uses
  Classes, SysUtils,
{$IFDEF WINDOWS}
  WinTypes, WinProcs,
  Graphics, Messages, Stdctrls
{$ENDIF}
{$IFDEF WIN32}
  Windows,
  Graphics, Messages, Stdctrls
{$ENDIF}
{$IFDEF LINUX}
  QT,
  QGraphics, QStdctrls
{$ENDIF}
  ;

const
  TCHECKGROUP_VERSION = 100;

type
  TCheckBoxArray = array [0..1023] of TCheckBox;
  pCheckBoxArray = ^TCheckBoxArray;

  TOnBoxClick = procedure(Sender: TObject; Tag: Integer) of object;

  TCheckGroup = class(TGroupBox)
  private
 { Private fields of TCheckGroup }
 { Storage for property Items }
    FItems : TStringList;
    FNo_CheckBoxes: Integer;
    FColumns: Byte;
    FOnBoxClick: TOnBoxClick;

 { Private methods of TCheckGroup }
    procedure SetColumns(Value : Byte);

 { Write method for property Items }
    procedure SetItems(Value : TStringList);
    {procedure CMFontChanged(var Message: TMessage);}
    {procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;}
{$IFDEF MSWINDOWS}
    procedure WMSize(var Message: TMessage); message WM_SIZE;
{$ENDIF}
{$IFDEF LINUX}
{$ENDIF}
  protected
    {procedure WMPaint(var Message: TWMPaint); message WM_PAINT;)}
    procedure DoBoxClick(Sender: TObject); virtual;
    procedure Loaded; override;
    procedure SetNoCheckBoxes(Value: Integer);
 { This arranges the CheckBoxes on the panel }
    Procedure OnItemsChange(Sender: TObject); virtual;
  public
 { A list of the CheckBoxes }
    CheckBoxes: pCheckBoxArray;

 { Public methods of TCheckGroup }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 { This sets the size of the CheckBoxes array, and creates the CheckBoxes }
    procedure ArrangeCheckBoxes;

  published
 { List of radio CheckBox names. The number of items sets the number o }
    property Columns: Byte read FColumns write SetColumns;
    property Items : TStringList read FItems write SetItems;
    property OnBoxClick: TOnBoxClick read FOnBoxClick write FOnBoxClick;
  end;

implementation

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.Create
  Description: standard constructor
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: initializes Properties
 Known Issues:
 ------------------------------------------------------------------------------}
constructor TCheckGroup.Create(AOwner: TComponent);
begin
{ Call the Create method of the container's parent class     }
   inherited Create(AOwner);

   Width := 81;
   Height := 217;
   Font.Style := [fsBold];

   FColumns := 1;
   FItems := TStringList.Create;
   FItems.OnChange := OnItemsChange;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.Destroy
  Description: standard destructor
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: frees the checkboxes
 Known Issues:
 ------------------------------------------------------------------------------}
destructor TCheckGroup.Destroy;
begin
   FItems.Free;
   SetNoCheckBoxes(0);

{ Last, free the component by calling the Destroy method of the  }
{ parent class.                          }
   inherited Destroy;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.DoBoxClick
  Description: responds to a click event of a single checkbox
       Author: Mat Ballard
 Suggested by: Robert Ross
 Date created: 11/27/2000
Date modified: 11/27/2000 by Mat Ballard
      Purpose: overrides the ancestor
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TCheckGroup.DoBoxClick(Sender: TObject);
begin
  if Assigned(FOnBoxClick) then
    OnBoxClick(Self, TCheckBox(Sender).Tag);
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.Loaded
  Description: responds to a load event
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: overrides the ancestor
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TCheckGroup.Loaded;
begin
  SetNoCheckBoxes(FItems.Count);
  ArrangeCheckBoxes;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.SetItems
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: sets the Items Property
 Known Issues: if the Items are changed programmatically, then
               the above routine is bypassed.
 ------------------------------------------------------------------------------}
procedure TCheckGroup.SetItems(Value : TStringList);
begin
{ Use Assign method because TStrings is an object type }
  FItems.Assign(Value);

  SetNoCheckBoxes(FItems.Count);
{ If changing this property affects the appearance of
     the component, call Invalidate here so the image will be
     updated. }
  Invalidate;
  ArrangeCheckBoxes;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.OnItemsChange
  Description: standard change event handler for Items
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: rearranges the checkboxes
 Known Issues:
 ------------------------------------------------------------------------------}
Procedure TCheckGroup.OnItemsChange(Sender: TObject);
begin
  SetNoCheckBoxes(FItems.Count);
  Invalidate;
  ArrangeCheckBoxes;
end;

procedure TCheckGroup.SetColumns(Value : Byte);
begin
  if (Value = 0) then Value := 1;
  FColumns := Value;
  ArrangeCheckBoxes;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.SetNoCheckBoxes
  Description: standard property Set procedure
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: This sets the size of the CheckBoxes array, and creates the CheckBoxes
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TCheckGroup.SetNoCheckBoxes(Value: Integer);
var
  i: Integer;
begin
  for i := 0 to FNo_CheckBoxes-1 do
  begin
    CheckBoxes^[i].Free;
  end;

  if (Value > 0) then
  begin
    CheckBoxes := AllocMem(Value*SizeOf(TCheckBox));
  end
  else
  begin
    FreeMem(CheckBoxes,
            FNo_CheckBoxes*SizeOf(TCheckBox));
    CheckBoxes := nil;
  end;

  FNo_CheckBoxes := Value;

{create the CheckBoxes:}
  for i := 0 to FNo_CheckBoxes-1 do
  begin
    CheckBoxes^[i] := TCheckBox.Create(Self);
    CheckBoxes^[i].Parent := Self;
    CheckBoxes^[i].Caption := FItems.Strings[i];
{Robert Ross suggests:}
    CheckBoxes^[i].Tag := i;
    CheckBoxes^[i].OnClick := DoBoxClick;
  end;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.ArrangeCheckBoxes
  Description: This arranges the CheckBoxes on the panel
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: Display management
 Known Issues:
 ------------------------------------------------------------------------------}
procedure TCheckGroup.ArrangeCheckBoxes;
var
  i,
  NoRows,
  TheTop,
  TheLeft,
  TheWidth,
  TheGap,
  DeltaHeight: Integer;
begin
  if (FNo_CheckBoxes > 0) then
  begin
{position the CheckBoxes:}
    TheTop := 24;
    TheLeft := 8;
    TheGap := 12;
    TheWidth := Width - (FColumns+1)*TheLeft - 2;
    TheWidth := TheWidth div FColumns;
    NoRows := FNo_CheckBoxes div FColumns;
    if ((NoRows * FColumns) < FNo_CheckBoxes) then
      Inc(NoRows);
    DeltaHeight := (Height - TheTop) div NoRows;

    for i := 0 to FNo_CheckBoxes-1 do
    begin
      CheckBoxes^[i].Top := TheTop + (i div FColumns)*DeltaHeight;
      CheckBoxes^[i].Left := TheLeft + (TheWidth + TheGap) * (i Mod FColumns);
      CheckBoxes^[i].Width := TheWidth;
      CheckBoxes^[i].Visible := TRUE;
      CheckBoxes^[i].Invalidate;
    end;
  end;
end;

{------------------------------------------------------------------------------
    Procedure: TCheckGroup.WMSize
  Description: standard ReSize message handler
       Author: Mat Ballard
 Date created: 04/25/2000
Date modified: 04/25/2000 by Mat Ballard
      Purpose: Re-Arranges the CheckBoxes
 Known Issues:
 ------------------------------------------------------------------------------}
{$IFDEF MSWINDOWS}
procedure TCheckGroup.WMSize(var Message: TMessage);
begin
  inherited;
  ArrangeCheckBoxes;
end;
{$ENDIF}

{procedure TCheckGroup.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ArrangeCheckBoxes;
end;}

{procedure TCheckGroup.WMPaint(var Message: TWMPaint);
var
  i: Integer;
begin
  inherited;
  Broadcast(Message);
end;}

end.