lazarus/lcl/checklst.pas

{ $Id$
 /***************************************************************************
                               checklst.pp
                               -----------

                   Initial Revision  : Thu Jun 19 CST 2003

 ***************************************************************************/

 *****************************************************************************
 *                                                                           *
 *  This file is part of the Lazarus Component Library (LCL)                 *
 *                                                                           *
 *  See the file COPYING.LCL, included in this distribution,                 *
 *  for details about the copyright.                                         *
 *                                                                           *
 *  This program is distributed in the hope that it will be useful,          *
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of           *
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                     *
 *                                                                           *
 *****************************************************************************
}

unit CheckLst;

{$mode objfpc} {$H+}

interface

uses
  Classes, SysUtils, StdCtrls, Graphics, GraphType, Controls, VCLGlobals, LMessages;
  

type
  { TCheckListBox }

  TCheckListBox = class(TCustomListBox)
  private
    FItemDataOffset: Integer;
    function GetChecked(const AIndex: Integer): Boolean;
    procedure SetChecked(const AIndex: Integer; const AValue: Boolean);
    procedure SendItemChecked(const AIndex: Integer; const AChecked: Boolean);
  protected
    procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); override;
    procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); override;
    function  GetCachedDataSize: Integer; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Checked[const AIndex: Integer]: Boolean read GetChecked write SetChecked;
  published
    property Align;
    property Anchors;
    property BorderStyle;
    property ExtendedSelect;
    property Items;
    property ItemHeight;
    property MultiSelect;
    property OnClick;
    property OnDblClick;
    property OnDrawItem;
    property OnEnter;
    property OnExit;
    property OnKeyPress;
    property OnKeyDown;
    property OnKeyUp;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnResize;
    property ParentShowHint;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property TopIndex;
    property Visible;
  end;


procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional',[TCheckListBox]);
end;

type
  PCachedItemData = ^TCachedItemData;
  TCachedItemData = Boolean;

{ TCheckListBox }

procedure TCheckListBox.AssignCacheToItemData(const AIndex: Integer; const AData: Pointer);
begin
  inherited AssignCacheToItemData(AIndex, AData);
  if PCachedItemData(AData + FItemDataOffset)^
  then SendItemChecked(AIndex, True);
end;

procedure TCheckListBox.AssignItemDataToCache(const AIndex: Integer; const AData: Pointer);
begin
  inherited AssignItemDataToCache(AIndex, AData);
  PCachedItemData(AData + FItemDataOffset)^ := Checked[AIndex];
end;

constructor TCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCompStyle := csCheckListBox;
  FItemDataOffset := inherited GetCachedDataSize;
end;

function TCheckListBox.GetCachedDataSize: Integer;
begin
  FItemDataOffset := inherited GetCachedDataSize;
  Result := FItemDataOffset + SizeOf(TCachedItemData);
end;

function TCheckListBox.GetChecked(const AIndex: Integer): Boolean;
begin
  CheckIndex(AIndex);

  if HandleAllocated
  then Result := (CNSendMessage(LM_CLB_GETCHECKED, Self, @AIndex) <> 0)
  else Result := PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^;
end;

procedure TCheckListBox.SendItemChecked(const AIndex: Integer; const AChecked: Boolean);
var
  Msg : TLMSetChecked;
begin
  if HandleAllocated
  then begin
    Msg.Index:= AIndex;
    Msg.Checked := AChecked;
    CNSendMessage(LM_CLB_SETCHECKED, Self, @Msg);
  end;
end;

procedure TCheckListBox.SetChecked(const AIndex: Integer; const AValue: Boolean);
begin
  CheckIndex(AIndex);

  if HandleAllocated
  then SendItemChecked(AIndex, AValue)
  else PCachedItemData(GetCachedData(AIndex) + FItemDataOffset)^ := AValue;
end;

end.

{ =============================================================================

  $Log$
  Revision 1.5  2004/02/23 08:19:04  micha
  revert intf split

  Revision 1.3  2003/07/09 00:13:18  marc
  * fixed cached items.object storage if TCheckListBox
  * Changed DebuggerOptions dialog to use new TCheckListBox

  Revision 1.2  2003/07/07 23:58:43  marc
  + Implemented TCheckListBox.Checked[] property


}