A Delphi CheckList Component
The Source Code
unit Chklst;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus;
type
TCheckList = class(TCustomListBox)
protected {Protected declarations}
property ExtendedSelect default False;
property MultiSelect default True;
property Style default lbOwnerDrawFixed;
property IntegralHeight default True;
procedure DrawItem (Index: Integer; Rect: TRect; State: TOwnerDrawState); override;
public
constructor Create (AOwner: TComponent); override;
published
property Align;
property BorderStyle;
property Color;
property Columns;
property Ctl3D;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ItemHeight;
property Items;
property ParentColor;
property ParentCtl3D;
property ParentFont;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Sorted;
property TabOrder;
property TabStop;
property Visible;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnKeyDown;
property OnKeyPress;
property OnKeyUp;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
end;
procedure Register;
implementation
constructor TCheckList.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Style := lbOwnerDrawFixed;
IntegralHeight := True;
MultiSelect := True;
ExtendedSelect := False;
end;
procedure TCheckList.DrawItem(Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
Height, StringHeight : integer;
x1,y1,x2,y2 : integer;
sText : string;
begin
sText := Items[Index];
With Canvas Do
Begin
Brush.Color := clWhite;
FillRect(Rect);
Height := Rect.Bottom - Rect.Top;
y1 := Rect.Top + 2;
y2 := Rect.Top + Height - 2;
x1 := 4;
x2 := Height;
Rectangle (x1,y1,x2,y2);
If odSelected In State then
begin
MoveTo (x1,y1);
LineTo (x2,y2);
MoveTo (x1 ,y2 - 1);
LineTo (x2 - 1,y1);
end;
Font.Color := clBlack;
x1 := Height + x1;
y1 := Rect.Top;
StringHeight := TextHeight(sText);
If Height > StringHeight Then
y1 := y1 + (Height - StringHeight) div 2;
TextOut(x1,y1,sText);
end;
end;
procedure Register;
begin
RegisterComponents ('Samples', [TCheckList]);
end;
end.
As usual, use Options | Install Components to install this component into your system. Enjoy!
![]()