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!


[HOME] [TABLE OF CONTENTS] [SEARCH]