{--------------------------------------------------------------------
 TCheckGroup - Component for handling multiple checkboxes.

 Made by Andreas Oestlund, 1996.

 Address:  Andreas Oestlund
           Norrbro 39
           811 70 Jarbo
           Sweden

 E-Mail: andres@Kuai.se
 WWW: http://www.kuai.se/~andres

 TCheckGroupis released as postcard-ware, which means that you are
 free to use (modify) this software and sourcecode as you see fit.
 But if you like it, and plan to use it, please send me a postcard
 with comments or suggestions.
 If you use this component in a commercial product, I would be greatful
 if you could give me some credits.

 Remember! Information wants to be free!
---------------------------------------------------------------------}

Unit ChkGroup;

{$R-}

interface

Uses
    WinTypes, WinProcs, Messages, SysUtils, Classes, Controls, Forms,
    StdCtrls;

type
    TCheckBoxClick = Procedure (Sender: TObject; Index : Integer; Checked : Boolean) of object;

  TCheckGroup = class(TScrollBox)
  private
    FOnCheckBoxClick : TCheckBoxClick;
    FChkBoxes: TList;
    FItems: TStrings;
    FItemIndex: Integer;
    FReading: Boolean;
    FUpdating: Boolean;
    FDistance : Integer;

    procedure ArrangeChkBoxes;
    procedure ButtonClick(Sender: TObject);
    procedure ItemsChange(Sender: TObject);
    procedure SetButtonCount(Value: Integer);
    procedure SetItems(Value: TStrings);
    procedure SetDistance(Value: Integer);
    procedure UpdateChkBoxes;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  protected
    procedure ReadState(Reader: TReader); override;
    function  CanModify: Boolean; virtual;
    Function  ItemChecked(Index : Integer): Boolean;
    Procedure CheckItem(Index : Integer; Checked: Boolean);
  public
    Property  Checked[Index: Integer]: Boolean read ItemChecked write CheckItem;
    Procedure CheckAllItems(Checked: Boolean);
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
  published
    property OnClickCheck: TCheckBoxClick read FOnCheckBoxClick write FOnCheckBoxClick;
    property Distance : Integer read FDistance write SetDistance Default 1;
    property Items: TStrings read FItems write SetItems;
  end;

procedure Register;

implementation

type
  TChkGroupButton = class(TCheckBox)
  public
    constructor Create(CheckGroup: TCheckGroup);
    destructor Destroy; override;
  end;

constructor TChkGroupButton.Create(CheckGroup: TCheckGroup);
     begin
          inherited Create(CheckGroup);

          CheckGroup.FChkBoxes.Add(Self);
          Visible := False;
          Enabled := CheckGroup.Enabled;
          ParentShowHint := False;
          OnClick := CheckGroup.ButtonClick;
          Parent := CheckGroup;
     end;

destructor TChkGroupButton.Destroy;
     begin
          TCheckGroup(Owner).FChkBoxes.Remove(Self);
          inherited Destroy;
     end;

{******************************************************************************}

constructor TCheckGroup.Create(AOwner: TComponent);
     begin
          inherited Create(AOwner);
          ControlStyle := [csSetCaption, csDoubleClicks];
          FChkBoxes := TList.Create;
          FItems := TStringList.Create;
          TStringList(FItems).OnChange := ItemsChange;
          FItemIndex := -1;
          FDistance := 1;
          VertScrollBar.Increment := 14;
          VertScrollBar.Tracking := True;
     end;

destructor TCheckGroup.Destroy;
     begin
          SetButtonCount(0);
          TStringList(FItems).OnChange := nil;
          FItems.Free;
          FChkBoxes.Free;

          inherited Destroy;
     end;

procedure TCheckGroup.ArrangeChkBoxes;
Var
   i : Integer;
   DC: HDC;
   SaveFont: HFont;
   Extent : TSize;
   S : String;

     begin
          If (FChkBoxes.Count = 0) Or FReading Then Exit;

          DC := GetDC(0);
          SaveFont := SelectObject(DC, Font.Handle);

          For i := 0 to FChkBoxes.Count - 1 do
            with TChkGroupButton(FChkBoxes[I]) do
               begin
                    S := Caption;
                    GetTextExtentPoint(DC, @S[1], Length(S), Extent);
                    SetBounds(8,1+(i*(Extent.cY+FDistance)),Extent.cX+20,Extent.cY);
                    Visible := True;
               end;

          SelectObject(DC, SaveFont);
          ReleaseDC(0, DC);
     end;

procedure TCheckGroup.ButtonClick(Sender: TObject);
     begin
          if not FUpdating then
           begin
                FItemIndex := FChkBoxes.IndexOf(Sender);
                Click;
                If Assigned(FOnCheckBoxClick) Then FOnCheckBoxClick(Self, FItemIndex,
                   TChkGroupButton(FChkBoxes[FItemIndex]).Checked);
           end;
     end;

procedure TCheckGroup.ItemsChange(Sender: TObject);
     begin
          if not FReading then
           begin
                if FItemIndex >= FItems.Count then FItemIndex := FItems.Count - 1;
                UpdateChkBoxes;
           end;
     end;

procedure TCheckGroup.ReadState(Reader: TReader);
     begin
          FReading := True;
          inherited ReadState(Reader);
          FReading := False;

          UpdateChkBoxes;
     end;

procedure TCheckGroup.SetButtonCount(Value: Integer);
     begin
          while FChkBoxes.Count < Value do TChkGroupButton.Create(Self);
          while FChkBoxes.Count > Value do TChkGroupButton(FChkBoxes.Last).Free;
     end;

procedure TCheckGroup.SetItems(Value: TStrings);
     begin
          FItems.Assign(Value);
     end;

Procedure TCheckGroup.SetDistance(Value : Integer);
     Begin
          If FDistance <> Value Then
           Begin
                FDistance := Value;
                HorzScrollBar.Position := 0;
                VertScrollBar.Position := 0;
                ArrangeChkBoxes;
           End;
     End;

procedure TCheckGroup.UpdateChkBoxes;
var
   i : Integer;
   S : String;

     begin
          SetButtonCount(FItems.Count);

          For i := 0 to FChkBoxes.Count - 1 do
            Begin
                 S := FItems[i];
                 TChkGroupButton(FChkBoxes[i]).Caption := S;
            End;

          if FItemIndex >= 0 then
           begin
                FUpdating := True;
                TChkGroupButton(FChkBoxes[FItemIndex]).Checked := True;
                FUpdating := False;
           end;

          ArrangeChkBoxes;
     end;

procedure TCheckGroup.CMEnabledChanged(var Message: TMessage);
Var
  i : Integer;

     begin
          inherited;

          For i := 0 to FChkBoxes.Count - 1 Do
              TChkGroupButton(FChkBoxes[i]).Enabled := Enabled;
     end;

procedure TCheckGroup.CMFontChanged(var Message: TMessage);
     begin
          inherited;
          ArrangeChkBoxes;
     end;

function TCheckGroup.CanModify: Boolean;
     begin
          Result := True;
     end;

(******************************************************************************)

Function TCheckGroup.ItemChecked(Index : Integer) : Boolean;
     Begin
          If Index <= FChkBoxes.Count Then
             Result := TChkGroupButton(FChkBoxes[Index]).Checked
           Else
               Result := False;
     End;

Procedure TCheckGroup.CheckItem(Index: Integer; Checked: Boolean);
     Begin
          If Index <= FChkBoxes.Count Then
           Begin
                TChkGroupButton(FChkBoxes[Index]).Checked := Checked;
                Invalidate;
           End;
     End;

Procedure TCheckGroup.CheckAllItems(Checked: Boolean);
Var
   Index : Integer;

     Begin
          For Index := 0 To FChkBoxes.Count-1 Do TChkGroupButton(FChkBoxes[Index]).Checked := Checked;
          Invalidate;
     End;

procedure Register;
     begin
          RegisterComponents('Samples', [TCheckGroup]);
     end;

end.