Hello, i am trying to make a CustomCheckListBox but i cant seem to get it to display my items the box itself creats fine and all the rest seems fine but it wont display my items any help on this matter would be greatly apreciated Thanks.

here most of the code im useing

unit AlarmCheckListBox;

{$R-,T-,H+,X+}

interface
Uses Messages, AlarmMessages, {$IFDEF LINUX} WinUtils, {$ENDIF} Windows,
  SysUtils, Classes, Controls, Forms, Menus, Graphics, StdCtrls, GetDates,
  ExtCtrls, MMSystem, ShellAPI, DateUtils, Dialogs;

TAlarmItems = class(TCollection)
  private
    { Private declarations }
    FOwner: TCustomAlarmBox;
    FUpdateCount: Integer;
  protected
    { Protected declarations }
    procedure Put(Index: Integer; const Item: TAlarmItem); virtual;
    function Get(Index: Integer): TAlarmItem; virtual; abstract;
    function GetCount: Integer; virtual; abstract;
    function GetObject(Index: Integer): TObject; virtual;
    procedure PutObject(Index: Integer; AObject: TObject); virtual;
    procedure SetUpdateState(Updating: Boolean); virtual;
    procedure Error(const Msg: string; Data: Integer); overload;
    procedure Error(Msg: PResStringRec; Data: Integer); overload;
    property UpdateCount: Integer read FUpdateCount;
    function GetOwner: TPersistent; override;
  public
    { Public declarations }
    constructor Create(AOwner: TCustomAlarmBox);
    function Add(const A: TAlarmItem): Integer; virtual;
    procedure AddAlarmItem(A: TAlarmItems); virtual;
    function AddObject(const A: TAlarmItem; AObject: TObject): Integer; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure BeginUpdate;
    procedure Clear; virtual; abstract;
    property Count: Integer read GetCount;
    Procedure Delete(Index : Integer); virtual; abstract;
    procedure EndUpdate;
    procedure Exchange(Index1, Index2: Integer); virtual;
    procedure InsertObject(Index: Integer; const A: TAlarmItem;
      AObject: TObject); virtual;
    procedure Insert(Index: Integer; const Item: TAlarmItem); virtual; abstract;
    function IndexOf(const A: TAlarmItem): Integer; virtual;
    property Alarm[Index: Integer]: TAlarmItem read Get write Put; default;
    procedure Move(CurIndex, NewIndex: Integer); virtual;
    property Objects[Index: Integer]: TObject read GetObject write PutObject;
  end;

 TAOwnerDrawState = Windows.TOwnerDrawState;
  {$NODEFINE TAOwnerDrawState}
 TDrawItemEvent = procedure(Control: TWinControl; Index: Integer;
    Rect: TRect; State: TAOwnerDrawState) of object;

  TMeasureItemEvent = procedure(Control: TWinControl; Index: Integer;
    var Height: Integer) of object;
 TAlarmBoxStyle = (abStandard, abOwnerDrawFixed, abOwnerDrawVariable,
    abVirtual, abVirtualOwnerDraw);
  TABGetDataEvent = procedure(Control: TWinControl; Index: Integer;
    var Data: TAlarmItem) of object;
  TABGetDataObjectEvent = procedure(Control: TWinControl; Index: Integer;
    var DataObject: TObject) of object;
  TABFindDataEvent = function(Control: TWinControl;
    FindAlarmItem: TAlarmItem): Integer of object;
  TAlarmBoxState = (abUnchecked, abChecked, abGrayed);

  TCustomAlarmControl = class(TWinControl)
  protected
    function GetCount: Integer; virtual; abstract;
    function GetItemIndex: Integer; virtual; abstract;
    procedure SetItemIndex(const Value: Integer); overload; virtual; abstract;
  public
    procedure AddItem(Item: TAlarmItem; AObject: TObject); virtual; abstract;
    procedure Clear; virtual; abstract;
    procedure ClearSelection; virtual; abstract;
    procedure CopySelection(Destination: TCustomAlarmControl); virtual; abstract;
    procedure DeleteSelected; virtual; abstract;
    procedure MoveSelection(Destination: TCustomAlarmControl); virtual;
    procedure SelectAll; virtual; abstract;
    property ItemIndex: Integer read GetItemIndex write SetItemIndex;
  end;

  TCustomMultiSelectAlarmControl = class(TCustomAlarmControl)
  protected
    FMultiSelect: Boolean;
    function GetSelCount: Integer; virtual; abstract;
    procedure SetMultiSelect(Value: Boolean); virtual; abstract;
  public
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
    property SelCount: Integer read GetSelCount;
  end;

 TCustomAlarmBox = class(TCustomMultiSelectAlarmControl)
  private

    FAutoComplete: Boolean;
    FCount: Integer;
    FItems: TAlarmItems;
    FFilter: String;
    FLastTime: Cardinal;
    FBorderStyle: TBorderStyle;
    FCanvas: TCanvas;
    FColumns: Integer;
    FItemHeight: Integer;
    FOldCount: Integer;
    FStyle: TAlarmBoxStyle;
    FIntegralHeight: Boolean;
    FSorted: Boolean;
    FExtendedSelect: Boolean;
    FTabWidth: Integer;
    FSaveItems: TStringList;
    FSaveTopIndex: Integer;
    FSaveItemIndex: Integer;
    FOnDrawItem: TDrawItemEvent;
    FOnMeasureItem: TMeasureItemEvent;
    FOnData: TABGetDataEvent;
    FOnDataFind: TABFindDataEvent;
    FOnDataObject: TABGetDataObjectEvent;
    FNotSnoozing : TNotSnoozing;
    function GetItemHeight: Integer;
    function GetTopIndex: Integer;
    procedure ABGetText(var Message: TMessage); message LB_GETTEXT;
    procedure ABGetTextLen(var Message: TMessage); message LB_GETTEXTLEN;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetColumnWidth;
    procedure SetColumns(Value: Integer);
    procedure SetCount(const Value: Integer);
    procedure SetExtendedSelect(Value: Boolean);
    procedure SetIntegralHeight(Value: Boolean);
    procedure SetItemHeight(Value: Integer);
    procedure SetItems(Value: TAlarmItems);
    procedure SetSelected(Index: Integer; Value: Boolean);
    procedure SetSorted(Value: Boolean);
    procedure SetStyle(Value: TAlarmBoxStyle);
    procedure SetTabWidth(Value: Integer);
    procedure SetTopIndex(Value: Integer);
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure CNCommand(var Message: TWMCommand); message CN_COMMAND;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM;
    procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    function GetScrollWidth: Integer;
    procedure SetScrollWidth(const Value: Integer);
  protected
    FMoving: Boolean;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    function DoGetData(const Index: Integer): TAlarmItem;
    function DoGetDataObject(const Index: Integer): TObject;
    function DoFindData(const Data: TAlarmItem): Integer;
    procedure WndProc(var Message: TMessage); override;
    procedure DragCanceled; override;
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TAOwnerDrawState); virtual;
    function GetCount: Integer; override;
    function GetSelCount: Integer; override;
    procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
    function InternalGetItemData(Index: Integer): Longint; dynamic;
    procedure InternalSetItemData(Index: Integer; AData: Longint); dynamic;
    function GetItemData(Index: Integer): LongInt; dynamic;
    function GetItemIndex: Integer; override;
    function GetSelected(Index: Integer): Boolean;
    procedure KeyPress(var Key: Char); override;
    procedure SetItemData(Index: Integer; AData: LongInt); dynamic;
    procedure ResetContent; dynamic;
    procedure DeleteAlarm(Index: Integer); dynamic;
    procedure SetMultiSelect(Value: Boolean); override;
    procedure SetItemIndex(const Value: Integer); override;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Columns: Integer read FColumns write SetColumns default 0;
    property ExtendedSelect: Boolean read FExtendedSelect write SetExtendedSelect default True;
    property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
    property ItemHeight: Integer read GetItemHeight write SetItemHeight;
    property ParentColor default False;
    property Sorted: Boolean read FSorted write SetSorted default False;
    property Style: TAlarmBoxStyle read FStyle write SetStyle default abStandard;
    property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
    property OnDrawItem: TDrawItemEvent read FOnDrawItem write FOnDrawItem;
    property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
    property OnData: TABGetDataEvent read FOnData write FOnData;
    property OnDataObject: TABGetDataObjectEvent read FOnDataObject write FOnDataObject;
    property OnDataFind: TABFindDataEvent read FOnDataFind write FOnDataFind;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure AddItem(Item: TAlarmItem; AObject: TObject); override;
    procedure Clear; override;
    procedure ClearSelection; override;
    procedure CopySelection(Destination: TCustomAlarmControl); override;
    procedure DeleteSelected; override;
    function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
    function ItemRect(Index: Integer): TRect;
    procedure SelectAll; override;
    property AutoComplete: Boolean read FAutoComplete write FAutoComplete default True;
    property Canvas: TCanvas read FCanvas;
    property Count: Integer read GetCount write SetCount;
    property Items: TAlarmItems read FItems write SetItems;
    property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
    property ScrollWidth: Integer read GetScrollWidth write SetScrollWidth default 0;
    property TopIndex: Integer read GetTopIndex write SetTopIndex;
    property OnIsSnoozing: TNotSnoozing read FNotSnoozing write FNotSnoozing;

  published
    property TabStop default True;
  end;

  TAlarmCheckListBox = class(TCustomAlarmBox)
  private
    FAllowGrayed: Boolean;
    FFlat: Boolean;
    FStandardItemHeight: Integer;
    FOnClickCheck: TNotifyEvent;
    FSaveStates: TList;
    FHeaderColor: TColor;
    FHeaderBackgroundColor: TColor;
    procedure ResetItemHeight;
    procedure DrawCheck(R: TRect; AState: TAlarmBoxState; AEnabled: Boolean);
    procedure SetChecked(Index: Integer; AChecked: Boolean);
    function GetChecked(Index: Integer): Boolean;
    procedure SetState(Index: Integer; AState: TAlarmBoxState);
    function GetState(Index: Integer): TAlarmBoxState;
    procedure ToggleClickCheck(Index: Integer);
    procedure InvalidateCheck(Index: Integer);
    function CreateWrapper(Index: Integer): TObject;
    function ExtractWrapper(Index: Integer): TObject;
    function GetWrapper(Index: Integer): TObject;
    function HaveWrapper(Index: Integer): Boolean;
    procedure SetFlat(Value: Boolean);
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure WMDestroy(var Msg : TWMDestroy);message WM_DESTROY;
    function GetItemEnabled(Index: Integer): Boolean;
    procedure SetItemEnabled(Index: Integer; const Value: Boolean);
    function GetHeader(Index: Integer): Boolean;
    procedure SetHeader(Index: Integer; const Value: Boolean);
    procedure SetHeaderBackgroundColor(const Value: TColor);
    procedure SetHeaderColor(const Value: TColor);
  protected
    procedure DrawItem(Index: Integer; Rect: TRect;
      State: TAOwnerDrawState); override;
    function InternalGetItemData(Index: Integer): Longint; override;
    procedure InternalSetItemData(Index: Integer; AData: Longint); override;
    procedure SetItemData(Index: Integer; AData: LongInt); override;
    function GetItemData(Index: Integer): LongInt; override;
    procedure KeyPress(var Key: Char); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure ResetContent; override;
    procedure DeleteAlarm(Index: Integer); override;
    procedure ClickCheck; dynamic;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure CreateWnd; override;
    procedure DestroyWnd; override;
    function GetCheckWidth: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
    property ItemEnabled[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
    property State[Index: Integer]: TAlarmBoxState read GetState write SetState;
    property Header[Index: Integer]: Boolean read GetHeader write SetHeader;
  published
    property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
    property Align;
    property AllowGrayed: Boolean read FAllowGrayed write FAllowGrayed default False;
    property Anchors;
    property AutoComplete;
    property BevelEdges;
    property BevelInner;
    property BevelOuter;
    property BevelKind;
    property BevelWidth;
    property BiDiMode;
    property BorderStyle;
    property Color;
    property Columns;
    property Constraints;
    property Ctl3D;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Flat: Boolean read FFlat write SetFlat default True;
    //property ExtendedSelect;
    property Font;
    property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clInfoText;
    property HeaderBackgroundColor: TColor read FHeaderBackgroundColor write SetHeaderBackgroundColor default clInfoBk;
    property ImeMode;
    property ImeName;
    property IntegralHeight;
    property ItemHeight;
    property Items;
    //property MultiSelect;
    property ParentBiDiMode;
    property ParentColor;
    property ParentCtl3D;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Sorted;
    property Style;
    property TabOrder;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnClick;
    property OnContextPopup;
    property OnData;
    property OnDataFind;
    property OnDataObject;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawItem;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMeasureItem;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDock;
    property OnStartDrag;

  end;

procedure Register;
implementation
uses Consts, RTLConsts, Themes, MultiAlarmA, msgdlg;

{ AlarmItems }

function TAlarmItems.Add(const A: TAlarmItem): Integer;
begin
  Result := GetCount;
  Insert(Result, A);
end;

procedure TAlarmItems.AddAlarmItem(A: TAlarmItems);
var
  I: Integer;
begin
  BeginUpdate;
  try
    for I := 0 to A.Count - 1 do
      AddObject(A[I], Objects[I]);
  finally
    EndUpdate;
  end;
end;

function TAlarmItems.AddObject(const A: TAlarmItem; AObject: TObject): Integer;
begin
  Result := Add(A);
  PutObject(Result, AObject);
end;

procedure TAlarmItems.Assign(Source: TPersistent);
begin
  if Source is TAlarmItems then
  begin
    BeginUpdate;
    try
      Clear;
      AddAlarmItem(TAlarmItems(Source));
    finally
      EndUpdate;
    end;
    Exit;
  end;
  inherited Assign(Source);
end;

procedure TAlarmItems.BeginUpdate;
begin
  if FUpdateCount = 0 then SetUpdateState(True);
  Inc(FUpdateCount);
end;

constructor TAlarmItems.Create(AOwner: TCustomAlarmBox);
begin
  inherited Create(TAlarmItem);
  FOwner := AOwner;
end;

procedure TAlarmItems.Error(const Msg: string; Data: Integer);
function ReturnAddr: Pointer;
  asm
          MOV     EAX,[EBP+4]
  end;

begin
  raise EStringListError.CreateFmt(Msg, [Data]) at ReturnAddr;
end;

procedure TAlarmItems.EndUpdate;
begin
  Dec(FUpdateCount);
  if FUpdateCount = 0 then SetUpdateState(False);
end;

procedure TAlarmItems.Error(Msg: PResStringRec; Data: Integer);
begin
 Error(LoadResString(Msg), Data);
end;

procedure TAlarmItems.Exchange(Index1, Index2: Integer);
var
  TempObject: TObject;
  TempItem: TAlarmItem;
begin
  BeginUpdate;
  try
    TempItem := Alarm[Index1];
    TempObject := Objects[Index1];
    Alarm[Index1] := Alarm[Index2];
    Objects[Index1] := Objects[Index2];
    Alarm[Index2] := TempItem;
    Objects[Index2] := TempObject;
  finally
    EndUpdate;
  end;
end;

function TAlarmItems.GetObject(Index: Integer): TObject;
begin
  Result := Nil;
end;

function TAlarmItems.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TAlarmItems.IndexOf(const A: TAlarmItem): Integer;
begin
  for Result := 0 to GetCount - 1 do
    if CompareAlarmItem(Get(Result), A) = 0 then Exit;
  Result := -1;
end;

procedure TAlarmItems.InsertObject(Index: Integer; const A: TAlarmItem;
  AObject: TObject);
begin
  Insert(Index, A);
  PutObject(Index, AObject);
end;

procedure TAlarmItems.Move(CurIndex, NewIndex: Integer);
var
  TempObject: TObject;
  TempItem: TAlarmItem;
begin
  if CurIndex <> NewIndex then
  begin
    BeginUpdate;
    try
      TempItem := Get(CurIndex);
      TempObject := GetObject(CurIndex);
      Delete(CurIndex);
      InsertObject(NewIndex, TempItem, TempObject);
    finally
      EndUpdate;
    end;
  end;
end;

procedure TAlarmItems.Put(Index: Integer; const Item: TAlarmItem);
var
  TempObject: TObject;
begin
  TempObject := GetObject(Index);
  Delete(Index);
  InsertObject(Index, Item, TempObject);
end;

procedure TAlarmItems.PutObject(Index: Integer; AObject: TObject);
begin
end;

procedure TAlarmItems.SetUpdateState(Updating: Boolean);
begin
end;

const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);

{ TCustomAlarmBox }
type

 TAlarmBoxItems = class(TAlarmItems)
  private
    AlarmBox: TCustomAlarmBox;
  protected
    procedure Put(Index: Integer; const A: TAlarmItem); override;
    function Get(Index: Integer): TAlarmItem; override;
    function GetCount: Integer; override;
    function GetObject(Index: Integer): TObject; override;
    procedure PutObject(Index: Integer; AObject: TObject); override;
    procedure SetUpdateState(Updating: Boolean); override;
  public
    function Add(const A: TAlarmItem): Integer; override;
    procedure Clear; override;
    procedure Delete(Index: Integer); override;
    procedure Exchange(Index1, Index2: Integer); override;
    function IndexOf(const A: TAlarmItem): Integer; override;
    procedure Insert(Index: Integer; const A: TAlarmItem); override;
    procedure Move(CurIndex, NewIndex: Integer); override;
  end;

{ TAlarmBoxItems }

function TAlarmBoxItems.GetCount: Integer;
begin
  Result := SendMessage(AlarmBox.Handle, AB_GETCOUNT, 0, 0);
end;

function TAlarmBoxItems.Get(Index: Integer): TAlarmItem;
var
  Len: Integer;
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then
    Result := AlarmBox.DoGetData(Index)
  else
  begin
    Len := SendMessage(AlarmBox.Handle, AB_GETTEXTLEN, Index, 0);
    if Len = LB_ERR then Error(SListIndexError, Index);
    SetLength(Result.FCaption, Len);
    if Len <> 0 then
    begin
      Len := SendMessage(AlarmBox.Handle, AB_GETTEXT, Index, Longint(PChar(Result.GetDisplayName)));
      SetLength(Result.FCaption, Len);  // LB_GETTEXTLEN isn't guaranteed to be accurate
    end;
  end;
end;

function TAlarmBoxItems.GetObject(Index: Integer): TObject;
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then
    Result := AlarmBox.DoGetDataObject(Index)
  else
  begin
    Result := TObject(AlarmBox.GetItemData(Index));
    if Longint(Result) = LB_ERR then Error(SListIndexError, Index);
  end;
end;

procedure TAlarmBoxItems.Put(Index: Integer; const A: TAlarmItem);
var
  I: Integer;
  TempData: Longint;
begin
  I := AlarmBox.ItemIndex;
  TempData := AlarmBox.InternalGetItemData(Index);
  // Set the Item to 0 in case it is an object that gets freed during Delete
  AlarmBox.InternalSetItemData(Index, 0);
  Delete(Index);
  InsertObject(Index, A, nil);
  AlarmBox.InternalSetItemData(Index, TempData);
  AlarmBox.ItemIndex := I;
end;

procedure TAlarmBoxItems.PutObject(Index: Integer; AObject: TObject);
begin
  if (Index <> -1) and not (AlarmBox.Style in [abVirtual, abVirtualOwnerDraw]) then
    AlarmBox.SetItemData(Index, LongInt(AObject));
end;

function TAlarmBoxItems.Add(const A: TAlarmItem): Integer;
begin
  Result := -1;
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then exit;
  Result := SendMessage(AlarmBox.Handle, AB_ADDSTRING, 0, Longint(PChar(A.GetDisplayName)));
  if Result < 0 then raise EOutOfResources.Create(SInsertLineError);
end;

procedure TAlarmBoxItems.Insert(Index: Integer; const A: TAlarmItem);
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then exit;
  if SendMessage(AlarmBox.Handle, AB_INSERTSTRING, Index,
    Longint(PChar(A.GetDisplayName))) < 0 then
    raise EOutOfResources.Create(SInsertLineError);
end;

procedure TAlarmBoxItems.Delete(Index: Integer);
begin
  AlarmBox.DeleteAlarm(Index);
end;

procedure TAlarmBoxItems.Exchange(Index1, Index2: Integer);
var
  TempData: Longint;
  TempItem: TAlarmItem;
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then exit;
  BeginUpdate;
  try
    TempItem := Alarm[Index1];
    TempData := AlarmBox.InternalGetItemData(Index1);
    Alarm[Index1] := Alarm[Index2];
    AlarmBox.InternalSetItemData(Index1, AlarmBox.InternalGetItemData(Index2));
    Alarm[Index2] := TempItem;
    AlarmBox.InternalSetItemData(Index2, TempData);
    if AlarmBox.ItemIndex = Index1 then
      AlarmBox.ItemIndex := Index2
    else if AlarmBox.ItemIndex = Index2 then
      AlarmBox.ItemIndex := Index1;
  finally
    EndUpdate;
  end;
end;

procedure TAlarmBoxItems.Clear;
begin
  AlarmBox.ResetContent;
end;

procedure TAlarmBoxItems.SetUpdateState(Updating: Boolean);
begin
  SendMessage(AlarmBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
  if not Updating then AlarmBox.Refresh;
end;

function TAlarmBoxItems.IndexOf(const A: TAlarmItem): Integer;
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then
    Result := AlarmBox.DoFindData(A)
  else
    Result := SendMessage(AlarmBox.Handle, AB_FINDSTRINGEXACT, -1,
    LongInt(PChar(A.GetDisplayName)));
end;

procedure TAlarmBoxItems.Move(CurIndex, NewIndex: Integer);
var
  TempData: Longint;
  TempItem: TAlarmItem;
begin
  if AlarmBox.Style in [abVirtual, abVirtualOwnerDraw] then exit;
  BeginUpdate;
  AlarmBox.FMoving := True;
  try
    if CurIndex <> NewIndex then
    begin
      TempItem := Get(CurIndex);
      TempData := AlarmBox.InternalGetItemData(CurIndex);
      AlarmBox.InternalSetItemData(CurIndex, 0);
      Delete(CurIndex);
      Insert(NewIndex, TempItem);
      AlarmBox.InternalSetItemData(NewIndex, TempData);
    end;
  finally
    AlarmBox.FMoving := False;
    EndUpdate;
  end;
end;

constructor TCustomAlarmBox.Create(AOwner: TComponent);
const
  AlarmBoxStyle = [csSetCaption, csDoubleClicks, csOpaque];
begin
  inherited Create(AOwner);
  if NewStyleControls then
    ControlStyle := AlarmBoxStyle else
    ControlStyle := AlarmBoxStyle + [csFramed];
  Width := 121;
  Height := 97;
  TabStop := True;
  ParentColor := False;
  FAutoComplete := True;
  FItems := TAlarmBoxItems.Create(Nil);
  TAlarmBoxItems(FItems).AlarmBox := Self;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  FItemHeight := 16;
  FBorderStyle := bsSingle;
  FExtendedSelect := True;
  FOldCount := -1;
end;

destructor TCustomAlarmBox.Destroy;
begin
  inherited Destroy;
  FCanvas.Free;
  FItems.Free;
  FSaveItems.Free;
end;

procedure TCustomAlarmBox.AddItem(Item: TAlarmItem; AObject: TObject);
var
  S: TAlarmItem;
begin
  S := Item;
  //SetString(S, PChar(Item), StrLen(PChar(Item)));
  Items.AddObject(S, AObject);
end;

function TCustomAlarmBox.GetItemData(Index: Integer): LongInt;
begin
  Result := SendMessage(Handle, AB_GETITEMDATA, Index, 0);
end;

procedure TCustomAlarmBox.SetItemData(Index: Integer; AData: LongInt);
begin
  SendMessage(Handle, AB_SETITEMDATA, Index, AData);
end;

function TCustomAlarmBox.InternalGetItemData(Index: Integer): LongInt;
begin
  Result := GetItemData(Index);
end;

procedure TCustomAlarmBox.InternalSetItemData(Index: Integer; AData: LongInt);
begin
  SetItemData(Index, AData);
end;

procedure TCustomAlarmBox.DeleteAlarm( Index: Integer );
begin
  SendMessage(Handle, AB_DELETESTRING, Index, 0);
end;

procedure TCustomAlarmBox.ResetContent;
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then exit;
  SendMessage(Handle, AB_RESETCONTENT, 0, 0);
end;

procedure TCustomAlarmBox.Clear;
begin
  FItems.Clear;
end;

procedure TCustomAlarmBox.ClearSelection;
var
  I: Integer;
begin
  if MultiSelect then
    for I := 0 to Items.Count - 1 do
      Selected[I] := False
  else
    ItemIndex := -1;
end;

procedure TCustomAlarmBox.CopySelection(Destination: TCustomAlarmControl);
var
  I: Integer;
begin
  if MultiSelect then
  begin
    for I := 0 to Items.Count - 1 do
      if Selected[I] then
        Destination.AddItem(Items.Alarm[I], Items.Alarm[I]);
  end
  else
    if ItemIndex <> -1 then
      Destination.AddItem(Items.Alarm[ItemIndex], Items.Alarm[ItemIndex]);
end;

procedure TCustomAlarmBox.DeleteSelected;
var
  I: Integer;
begin
  if MultiSelect then
  begin
    for I := Items.Count - 1 downto 0 do
      if Selected[I] then
        Items.Delete(I);
  end
  else
    if ItemIndex <> -1 then
      Items.Delete(ItemIndex);
end;

procedure TCustomAlarmBox.SetColumnWidth;
var
  ColWidth: Integer;
begin
  if (FColumns > 0) and (Width > 0) then
  begin
    ColWidth := Trunc(ClientWidth / FColumns);
    if ColWidth < 1 then ColWidth := 1;
    SendMessage(Handle, AB_SETCOLUMNWIDTH, ColWidth, 0);
  end;
end;

procedure TCustomAlarmBox.SetColumns(Value: Integer);
begin
  if FColumns <> Value then
    if (FColumns = 0) or (Value = 0) then
    begin
      FColumns := Value;
      RecreateWnd;
    end else
    begin
      FColumns := Value;
      if HandleAllocated then SetColumnWidth;
    end;
end;

function TCustomAlarmBox.GetItemIndex: Integer;
begin
  if MultiSelect then
    Result := SendMessage(Handle, AB_GETCARETINDEX, 0, 0)
  else
    Result := SendMessage(Handle, AB_GETCURSEL, 0, 0);
end;

function TCustomAlarmBox.GetCount: Integer;
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then
    Result := FCount
  else
    Result := Items.Count;
end;

function TCustomAlarmBox.GetSelCount: Integer;
begin
  Result := SendMessage(Handle, AB_GETSELCOUNT, 0, 0);
end;

procedure TCustomAlarmBox.SetItemIndex(const Value: Integer);
begin
  if GetItemIndex <> Value then
    if MultiSelect then SendMessage(Handle, AB_SETCARETINDEX, Value, 0)
    else SendMessage(Handle, AB_SETCURSEL, Value, 0);
end;

procedure TCustomAlarmBox.SetExtendedSelect(Value: Boolean);
begin
  if Value <> FExtendedSelect then
  begin
    FExtendedSelect := Value;
    RecreateWnd;
  end;
end;

procedure TCustomAlarmBox.SetIntegralHeight(Value: Boolean);
begin
  if Value <> FIntegralHeight then
  begin
    FIntegralHeight := Value;
    RecreateWnd;
    RequestAlign;
  end;
end;

function TCustomAlarmBox.GetItemHeight: Integer;
var
  R: TRect;
begin
  Result := FItemHeight;
  if HandleAllocated and (FStyle = abStandard) then
  begin
    Perform(LB_GETITEMRECT, 0, Longint(@R));
    Result := R.Bottom - R.Top;
  end;
end;

procedure TCustomAlarmBox.SetItemHeight(Value: Integer);
begin
  if (FItemHeight <> Value) and (Value > 0) then
  begin
    FItemHeight := Value;
    RecreateWnd;
  end;
end;

procedure TCustomAlarmBox.SetTabWidth(Value: Integer);
begin
  if Value < 0 then Value := 0;
  if FTabWidth <> Value then
  begin
    FTabWidth := Value;
    RecreateWnd;
  end;
end;

procedure TCustomAlarmBox.SetMultiSelect(Value: Boolean);
begin
  if FMultiSelect <> Value then
  begin
    FMultiSelect := Value;
    RecreateWnd;
  end;
end;

function TCustomAlarmBox.GetSelected(Index: Integer): Boolean;
var
  R: Longint;
begin
  R := SendMessage(Handle, AB_GETSEL, Index, 0);
  if R = LB_ERR then
    raise EListError.CreateResFmt(@SListIndexError, [Index]);
  Result := LongBool(R);
end;

procedure TCustomAlarmBox.SetSelected(Index: Integer; Value: Boolean);
begin
  if FMultiSelect then
  begin
    if SendMessage(Handle, AB_SETSEL, Longint(Value), Index) = LB_ERR then
      raise EListError.CreateResFmt(@SListIndexError, [Index]);
  end
  else
    if Value then
    begin
      if SendMessage(Handle, AB_SETCURSEL, Index, 0) = LB_ERR then
        raise EListError.CreateResFmt(@SListIndexError, [Index])
    end
    else
      SendMessage(Handle, AB_SETCURSEL, -1, 0);
end;

procedure TCustomAlarmBox.SetSorted(Value: Boolean);
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then exit;
  if FSorted <> Value then
  begin
    FSorted := Value;
    RecreateWnd;
  end;
end;

procedure TCustomAlarmBox.SetStyle(Value: TAlarmBoxStyle);
begin
  if FStyle <> Value then
  begin
    if Value in [abVirtual, abVirtualOwnerDraw] then
    begin
      Items.Clear;
      Sorted := False;
    end;
    FStyle := Value;
    RecreateWnd;
  end;
end;

function TCustomAlarmBox.GetTopIndex: Integer;
begin
  Result := SendMessage(Handle, AB_GETTOPINDEX, 0, 0);
end;

procedure TCustomAlarmBox.ABGetText(var Message: TMessage);
var
  A: TAlarmItem;
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then
  begin
    if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then
    begin
      A := Nil;
      OnData(Self, Message.wParam, A);
      StrCopy(PChar(Message.lParam), PChar(A.Caption));
      Message.Result := Length(A.Caption);
    end
    else
      Message.Result := LB_ERR;
  end
  else
    inherited;
end;

procedure TCustomAlarmBox.ABGetTextLen(var Message: TMessage);
var
  A: TAlarmItem;
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then
  begin
    if Assigned(FOnData) and (Message.WParam > -1) and (Message.WParam < Count) then
    begin
      A := Nil;
      OnData(Self, Message.wParam, A);
      Message.Result := Length(A.Caption);
    end
    else
      Message.Result := LB_ERR;
  end
  else
    inherited;
end;

procedure TCustomAlarmBox.SetBorderStyle(Value: TBorderStyle);
begin
  if FBorderStyle <> Value then
  begin
    FBorderStyle := Value;
    RecreateWnd;
  end;
end;

procedure TCustomAlarmBox.SetTopIndex(Value: Integer);
begin
  if GetTopIndex <> Value then
    SendMessage(Handle, AB_SETTOPINDEX, Value, 0);
end;

procedure TCustomAlarmBox.SetItems(Value: TAlarmItems);
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then
    case Style of
      abVirtual: Style := abStandard;
      abVirtualOwnerDraw: Style := abOwnerDrawFixed;
    end;
  Items.Assign(Value);
end;

function TCustomAlarmBox.ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
var
  Count: Integer;
  ItemRect: TRect;
begin
  if PtInRect(ClientRect, Pos) then
  begin
    Result := TopIndex;
    Count := Items.Count;
    while Result < Count do
    begin
      Perform(LB_GETITEMRECT, Result, Longint(@ItemRect));
      if PtInRect(ItemRect, Pos) then Exit;
      Inc(Result);
    end;
    if not Existing then Exit;
  end;
  Result := -1;
end;

function TCustomAlarmBox.ItemRect(Index: Integer): TRect;
var
  Count: Integer;
begin
  Count := Items.Count;
  if (Index = 0) or (Index < Count) then
    Perform(LB_GETITEMRECT, Index, Longint(@Result))
  else if Index = Count then
  begin
    Perform(LB_GETITEMRECT, Index - 1, Longint(@Result));
    OffsetRect(Result, 0, Result.Bottom - Result.Top);
  end else FillChar(Result, SizeOf(Result), 0);
end;

procedure TCustomAlarmBox.CreateParams(var Params: TCreateParams);
type
  PSelects = ^TSelects;
  TSelects = array[Boolean] of DWORD;
const
  Styles: array[TAlarmBoxStyle] of DWORD =
    (0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED,
     LBS_OWNERDRAWFIXED);
  Sorteds: array[Boolean] of DWORD = (0, LBS_SORT);
  MultiSelects: array[Boolean] of DWORD = (0, LBS_MULTIPLESEL);
  ExtendSelects: array[Boolean] of DWORD = (0, LBS_EXTENDEDSEL);
  IntegralHeights: array[Boolean] of DWORD = (LBS_NOINTEGRALHEIGHT, 0);
  MultiColumns: array[Boolean] of DWORD = (0, LBS_MULTICOLUMN);
  TabStops: array[Boolean] of DWORD = (0, LBS_USETABSTOPS);
  CSHREDRAW: array[Boolean] of DWORD = (CS_HREDRAW, 0);
  Data: array[Boolean] of DWORD = (LBS_HASSTRINGS, LBS_NODATA);
var
  Selects: PSelects;
begin
  inherited CreateParams(Params);
  CreateSubClass(Params, 'LISTBOX');
  with Params do
  begin
    Selects := @MultiSelects;
    if FExtendedSelect then Selects := @ExtendSelects;
    Style := Style or (WS_HSCROLL or WS_VSCROLL or
      Data[Self.Style in [abVirtual, abVirtualOwnerDraw]] or
      LBS_NOTIFY) or Styles[FStyle] or Sorteds[FSorted] or
      Selects^[FMultiSelect] or IntegralHeights[FIntegralHeight] or
      MultiColumns[FColumns <> 0] or BorderStyles[FBorderStyle] or
      TabStops[FTabWidth <> 0];
    if NewStyleControls and Ctl3D and (FBorderStyle = bsSingle) then
    begin
      Style := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.style := WindowClass.style and not (CSHREDRAW[UseRightToLeftAlignment] or CS_VREDRAW);
  end;
end;

procedure TCustomAlarmBox.CreateWnd;
var
  W, H: Integer;
begin
  W := Width;
  H := Height;
  inherited CreateWnd;
  SetWindowPos(Handle, 0, Left, Top, W, H, SWP_NOZORDER or SWP_NOACTIVATE);
  if FTabWidth <> 0 then
    SendMessage(Handle, AB_SETTABSTOPS, 1, Longint(@FTabWidth));
  SetColumnWidth;
  if (FOldCount <> -1) or Assigned(FSaveItems) then
  begin
    if (Style in [abVirtual, abVirtualOwnerDraw]) then
      Count := FOldCount;
    if FSaveItems <> nil then
    begin
      FItems.Assign(FSaveItems);
      FreeAndNil(FSaveItems);
    end;
    SetTopIndex(FSaveTopIndex);
    SetItemIndex(FSaveItemIndex);
    FOldCount := -1;
  end;
end;

procedure TCustomAlarmBox.DestroyWnd;
begin
  if (FItems.Count > 0) then
  begin
    if (Style in [abVirtual, abVirtualOwnerDraw]) then
      FOldCount := FItems.Count
    else
    begin
      FSaveItems := TStringList.Create;
      FSaveItems.Assign(FItems);
    end;
    FSaveTopIndex := GetTopIndex;
    FSaveItemIndex := GetItemIndex;
  end;
  inherited DestroyWnd;
end;

procedure TCustomAlarmBox.WndProc(var Message: TMessage);
begin
  {for auto drag mode, let listbox handle itself, instead of TControl}
  if not (csDesigning in ComponentState) and ((Message.Msg = WM_LBUTTONDOWN) or
    (Message.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
  begin
    if DragMode = dmAutomatic then
    begin
      if IsControlMouseMsg(TWMMouse(Message)) then
        Exit;
      ControlState := ControlState + [csLButtonDown];
      Dispatch(Message);  {overrides TControl's BeginDrag}
      Exit;
    end;
  end;
  inherited WndProc(Message);
end;

procedure TCustomAlarmBox.WMLButtonDown(var Message: TWMLButtonDown);
var
  ItemNo : Integer;
  ShiftState: TShiftState;
begin
  ShiftState := KeysToShiftState(Message.Keys);
  if (DragMode = dmAutomatic) and FMultiSelect then
  begin
    if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
    begin
      ItemNo := ItemAtPos(SmallPointToPoint(Message.Pos), True);
      if (ItemNo >= 0) and (Selected[ItemNo]) then
      begin
        BeginDrag (False);
        Exit;
      end;
    end;
  end;
  inherited;
  if (DragMode = dmAutomatic) and not (FMultiSelect and
    ((ssCtrl in ShiftState) or (ssShift in ShiftState))) then
    BeginDrag(False);
end;

procedure TCustomAlarmBox.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
    LBN_SELCHANGE:
      begin
        inherited Changed;
        Click;
      end;
    LBN_DBLCLK: DblClick;
  end;
end;

procedure TCustomAlarmBox.WMPaint(var Message: TWMPaint);

  procedure PaintListBox;
  var
    DrawItemMsg: TWMDrawItem;
    MeasureItemMsg: TWMMeasureItem;
    DrawItemStruct: TDrawItemStruct;
    MeasureItemStruct: TMeasureItemStruct;
    R: TRect;
    Y, I, H, W: Integer;
  begin

    { Initialize drawing records }
    DrawItemMsg.Msg := CN_DRAWITEM;
    DrawItemMsg.DrawItemStruct := @DrawItemStruct;
    DrawItemMsg.Ctl := Handle;
    DrawItemStruct.CtlType := ODT_LISTBOX;
    DrawItemStruct.itemAction := ODA_DRAWENTIRE;
    DrawItemStruct.itemState := 0;
    DrawItemStruct.hDC := Message.DC;
    DrawItemStruct.CtlID := Handle;
    DrawItemStruct.hwndItem := Handle;

    { Intialize measure records }
    MeasureItemMsg.Msg := CN_MEASUREITEM;
    MeasureItemMsg.IDCtl := Handle;
    MeasureItemMsg.MeasureItemStruct := @MeasureItemStruct;
    MeasureItemStruct.CtlType := ODT_LISTBOX;
    MeasureItemStruct.CtlID := Handle;

    { Draw the listbox }
    Y := 0;
    I := TopIndex;
    GetClipBox(Message.DC, R);
    H := Height;
    W := Width;
    while Y < H do
    begin
      MeasureItemStruct.itemID := I;
      if I < Items.Count then
      MeasureItemStruct.itemData := Longint(Pointer(Items.Objects[I]));
      MeasureItemStruct.itemWidth := W;
      MeasureItemStruct.itemHeight := FItemHeight;
      DrawItemStruct.itemData := MeasureItemStruct.itemData;
      DrawItemStruct.itemID := I;
      Dispatch(MeasureItemMsg);
      DrawItemStruct.rcItem := Rect(0, Y, MeasureItemStruct.itemWidth,
        Y + Integer(MeasureItemStruct.itemHeight));
      Dispatch(DrawItemMsg);
      Inc(Y, MeasureItemStruct.itemHeight);
      Inc(I);
      if I >= Items.Count then break;
    end;
  end;

begin
  if Message.DC <> 0 then
    { Listboxes don't allow paint "sub-classing" like the other windows controls
      so we have to do it ourselves. }
    PaintListBox
  else inherited;
end;

procedure TCustomAlarmBox.WMSize(var Message: TWMSize);
begin
  inherited;
  SetColumnWidth;
end;

procedure TCustomAlarmBox.DragCanceled;
var
  M: TWMMouse;
  MousePos: TPoint;
begin
  with M do
  begin
    Msg := WM_LBUTTONDOWN;
    GetCursorPos(MousePos);
    Pos := PointToSmallPoint(ScreenToClient(MousePos));
    Keys := 0;
    Result := 0;
  end;
  DefaultHandler(M);
  M.Msg := WM_LBUTTONUP;
  DefaultHandler(M);
end;

procedure TCustomAlarmBox.DrawItem(Index: Integer; Rect: TRect;
  State: TAOwnerDrawState);
var
  Flags: Longint;
  Data: String;
begin
  if Assigned(FOnDrawItem) then FOnDrawItem(Self, Index, Rect, State) else
  begin
    FCanvas.FillRect(Rect);
    if Index < Count then
    begin
      Flags := DrawTextBiDiModeFlags(DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
      if not UseRightToLeftAlignment then
        Inc(Rect.Left, 2)
      else
        Dec(Rect.Right, 2);
      Data := '';
      if (Style in [abVirtual, abVirtualOwnerDraw]) then
        Data := DoGetData(Index).Caption
      else
        Data := Items.Alarm[Index].FCaption;
      DrawText(FCanvas.Handle, PChar(Data), Length(Data), Rect, Flags);
    end;
  end;
end;

procedure TCustomAlarmBox.MeasureItem(Index: Integer; var Height: Integer);
begin
  if Assigned(FOnMeasureItem) then FOnMeasureItem(Self, Index, Height)
end;

procedure TCustomAlarmBox.CNDrawItem(var Message: TWMDrawItem);
var
  State: TAOwnerDrawState;
begin
  with Message.DrawItemStruct^ do
  begin
    State := TAOwnerDrawState(LongRec(itemState).Lo);
    FCanvas.Handle := hDC;
    FCanvas.Font := Font;
    FCanvas.Brush := Brush;
    if (Integer(itemID) >= 0) and (odSelected in State) then
    begin
      FCanvas.Brush.Color := clHighlight;
      FCanvas.Font.Color := clHighlightText
    end;
    if Integer(itemID) >= 0 then
      DrawItem(itemID, rcItem, State) else
      FCanvas.FillRect(rcItem);
    if odFocused in State then DrawFocusRect(hDC, rcItem);
    FCanvas.Handle := 0;
  end;
end;

procedure TCustomAlarmBox.CNMeasureItem(var Message: TWMMeasureItem);
begin
  with Message.MeasureItemStruct^ do
  begin
    itemHeight := FItemHeight;
    if FStyle = abOwnerDrawVariable then
      MeasureItem(itemID, Integer(itemHeight));
  end;
end;

procedure TCustomAlarmBox.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (FBorderStyle = bsSingle) then RecreateWnd;
  inherited;
end;

procedure TCustomAlarmBox.SelectAll;
var
  I: Integer;
begin
  if FMultiSelect then
    for I := 0 to Items.Count - 1 do
      Selected[I] := True;
end;

procedure TCustomAlarmBox.KeyPress(var Key: Char);

  procedure FindString;
  var
    Idx: Integer;
  begin
    if Style in [abVirtual, abVirtualOwnerDraw] then
      Idx := DoFindData(nil)
    else
      Idx := SendMessage(Handle, AB_FINDSTRING, -1, LongInt(PChar(FFilter)));
    if Idx <> LB_ERR then
    begin
      if MultiSelect then
      begin
        ClearSelection;
        SendMessage(Handle, AB_SELITEMRANGE, 1, MakeLParam(Idx, Idx))
      end;
      ItemIndex := Idx;
      Click;
    end;
    if not (Ord(Key) in [VK_RETURN, VK_BACK, VK_ESCAPE]) then
      Key := #0;  // Clear so that the listbox's default search mechanism is disabled
  end;

var
  Msg: TMsg;
begin
  inherited KeyPress(Key);
  if not FAutoComplete then exit;
  if GetTickCount - FLastTime >= 500 then
    FFilter := '';
  FLastTime := GetTickCount;

  if Ord(Key) <> VK_BACK then
  begin
    if Key in LeadBytes then
    begin
      if PeekMessage(Msg, Handle, WM_CHAR, WM_CHAR, PM_REMOVE) then
      begin
        FFilter := FFilter + Key + Chr(Msg.wParam);
        Key := #0;
      end;
    end
    else
      FFilter := FFilter + Key;
  end
  else
  begin
    while ByteType(FFilter, Length(FFilter)) = mbTrailByte do
      Delete(FFilter, Length(FFilter), 1);
    Delete(FFilter, Length(FFilter), 1);
  end;

  if Length(FFilter) > 0 then
    FindString
  else
  begin
    ItemIndex := 0;
    Click;
  end;
end;

procedure TCustomAlarmBox.SetCount(const Value: Integer);
var
  Error: Integer;
begin
  if Style in [abVirtual, abVirtualOwnerDraw] then
  begin
    // Limited to 32767 on Win95/98 as per Win32 SDK
    Error := SendMessage(Handle, AB_SETCOUNT, Value, 0);
    if (Error <> LB_ERR) and (Error <> LB_ERRSPACE) then
      FCount := Value
    else
      raise Exception.CreateFmt(SErrorSettingCount, [Name]);
  end
  else
    raise Exception.CreateFmt(SListBoxMustBeVirtual, [Name]);
end;

function TCustomAlarmBox.DoGetData(const Index: Integer): TAlarmItem;
begin
  if Assigned(FOnData) then FOnData(Self, Index, Result);
end;

function TCustomAlarmBox.DoGetDataObject(const Index: Integer): TObject;
begin
  if Assigned(FOnDataObject) then FOnDataObject(Self, Index, Result);
end;

function TCustomAlarmBox.DoFindData(const Data: TAlarmItem): Integer;
begin
  if Assigned(FOnDataFind) then
    Result := FOnDataFind(Self, Data)
  else
    Result := -1;
end;

function TCustomAlarmBox.GetScrollWidth: Integer;
begin
  Result := SendMessage(Handle, AB_GETHORIZONTALEXTENT, 0, 0);
end;

procedure TCustomAlarmBox.SetScrollWidth(const Value: Integer);
begin
  if Value <> ScrollWidth then
    SendMessage(Handle, AB_SETHORIZONTALEXTENT, Value, 0);
end;

type
  TAlarmCheckListBoxDataWrapper = class
  private
    FData: LongInt;
    FState: TAlarmBoxState;
    FDisabled: Boolean;
    FHeader: Boolean;
    procedure SetChecked(Check: Boolean);
    function GetChecked: Boolean;
  public
    class function GetDefaultState: TAlarmBoxState;
    property Checked: Boolean read GetChecked write SetChecked;
    property State: TAlarmBoxState read FState write FState;
    property Disabled: Boolean read FDisabled write FDisabled;
    property Header: Boolean read FHeader write FHeader;
  end;

var
  FCheckWidth, FCheckHeight: Integer;

procedure GetCheckSize;
begin
  with TBitmap.Create do
    try
      Handle := LoadBitmap(0, PChar(OBM_CHECKBOXES));
      FCheckWidth := Width div 4;
      FCheckHeight := Height div 3;
    finally
      Free;
    end;
end;

function MakeSaveState(State: TAlarmBoxState; Disabled: Boolean): TObject;
begin
  Result := TObject((Byte(State) shl 16) or Byte(Disabled));
end;

function GetSaveState(AObject: TObject): TAlarmBoxState;
begin
  Result := TAlarmBoxState(Integer(AObject) shr 16);
end;

function GetSaveDisabled(AObject: TObject): Boolean;
begin
  Result := Boolean(Integer(AObject) and $FF);
end;

{ TAlarmCheckListBoxDataWrapper }

procedure TAlarmCheckListBoxDataWrapper.SetChecked(Check: Boolean);
begin
  if Check then FState := abChecked else FState := abUnchecked;
end;

function TAlarmCheckListBoxDataWrapper.GetChecked: Boolean;
begin
  Result := FState = abChecked;
end;

class function TAlarmCheckListBoxDataWrapper.GetDefaultState: TAlarmBoxState;
begin
  Result := abUnchecked;
end;

{ TAlarmCheckListBox }

constructor TAlarmCheckListBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFlat := True;
  FHeaderColor := clInfoText;
  FHeaderBackgroundColor := clInfoBk;
end;

destructor TAlarmCheckListBox.Destroy;
begin
  FSaveStates.Free;
  inherited;
end;

procedure TAlarmCheckListBox.CreateWnd;
var
  I: Integer;
  Wrapper: TAlarmCheckListBoxDataWrapper;
  SaveState: TObject;
begin
  inherited CreateWnd;
  if FSaveStates <> nil then
  begin
    for I := 0 to FSaveStates.Count - 1 do
    begin
      Wrapper := TAlarmCheckListBoxDataWrapper(GetWrapper(I));
      SaveState := FSaveStates[I];
      Wrapper.FState := GetSaveState(SaveState);
      Wrapper.FDisabled := GetSaveDisabled(SaveState);
    end;
    FreeAndNil(FSaveStates);
  end;
  ResetItemHeight;
end;

procedure TAlarmCheckListBox.DestroyWnd;
var
  I: Integer;
begin
  if Items.Count > 0 then
  begin
    FSaveStates := TList.Create;
    for I := 0 to Items.Count - 1 do
      FSaveStates.Add(MakeSaveState(State[I], not ItemEnabled[I]));
  end;
  inherited DestroyWnd;
end;

procedure TAlarmCheckListBox.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do
    if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
      Style := Style or LBS_OWNERDRAWFIXED;
end;

function TAlarmCheckListBox.GetCheckWidth: Integer;
begin
  Result := FCheckWidth + 2;
end;

procedure TAlarmCheckListBox.CMFontChanged(var Message: TMessage);
begin
  inherited;
  ResetItemHeight;
end;

procedure TAlarmCheckListBox.ResetItemHeight;
begin
  if HandleAllocated and (Style = abStandard) then
  begin
    Canvas.Font := Font;
    FStandardItemHeight := Canvas.TextHeight('Wg');
    Perform(LB_SETITEMHEIGHT, 0, FStandardItemHeight);
  end;
end;

procedure TAlarmCheckListBox.DrawItem(Index: Integer; Rect: TRect;
  State: TAOwnerDrawState);
var
  R: TRect;
  SaveEvent: TDrawItemEvent;
  ACheckWidth: Integer;
  Enable: Boolean;
begin
  ACheckWidth := GetCheckWidth;
  if Index < Items.Count then
  begin
    R := Rect;
    Enable := Self.Enabled and GetItemEnabled(Index);
    if not Header[Index] then
    begin
      if not UseRightToLeftAlignment then
      begin
        R.Right := Rect.Left;
        R.Left := R.Right - ACheckWidth;
      end
      else
      begin
        R.Left := Rect.Right;
        R.Right := R.Left + ACheckWidth;
      end;
      DrawCheck(R, GetState(Index), Enable);
    end
    else
    begin
      Canvas.Font.Color := HeaderColor;
      Canvas.Brush.Color := HeaderBackgroundColor;
    end;
    if not Enable then
      Canvas.Font.Color := clGrayText;
  end;

  if (Style = abStandard) and Assigned(OnDrawItem) then
  begin
    { Force abStandard list to ignore OnDrawItem event. }
    SaveEvent := OnDrawItem;
    OnDrawItem := nil;
    try
      inherited;
    finally
      OnDrawItem := SaveEvent;
    end;
  end
  else
    inherited;
end;

procedure TAlarmCheckListBox.CNDrawItem(var Message: TWMDrawItem);
begin
  if Items.Count = 0 then exit;
  with Message.DrawItemStruct^ do
    if not Header[itemID] then
      if not UseRightToLeftAlignment then
        rcItem.Left := rcItem.Left + GetCheckWidth
      else
        rcItem.Right := rcItem.Right - GetCheckWidth;
  inherited;
end;

procedure TAlarmCheckListBox.DrawCheck(R: TRect; AState: TAlarmBoxState; AEnabled: Boolean);
var
  DrawState: Integer;
  DrawRect: TRect;
  OldBrushColor: TColor;
  OldBrushStyle: TBrushStyle;
  OldPenColor: TColor;
  Rgn, SaveRgn: HRgn;
  ElementDetails: TThemedElementDetails;
begin
  SaveRgn := 0;
  DrawRect.Left := R.Left + (R.Right - R.Left - FCheckWidth) div 2;
  DrawRect.Top := R.Top + (R.Bottom - R.Top - FCheckHeight) div 2;
  DrawRect.Right := DrawRect.Left + FCheckWidth;
  DrawRect.Bottom := DrawRect.Top + FCheckHeight;
  with Canvas do
  begin
    if Flat then
    begin
      { Remember current clipping region }
      SaveRgn := CreateRectRgn(0,0,0,0);
      GetClipRgn(Handle, SaveRgn);
      { Clip 3d-style checkbox to prevent flicker }
      with DrawRect do
        Rgn := CreateRectRgn(Left + 2, Top + 2, Right - 2, Bottom - 2);
      SelectClipRgn(Handle, Rgn);
      DeleteObject(Rgn);
    end;

   if ThemeServices.ThemesEnabled then
   begin
      case AState of
        abChecked:
          if AEnabled then
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedNormal)
          else
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxCheckedDisabled);
        abUnchecked:
          if AEnabled then
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedNormal)
          else
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxUncheckedDisabled)
        else // abGrayed
          if AEnabled then
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedNormal)
          else
            ElementDetails := ThemeServices.GetElementDetails(tbCheckBoxMixedDisabled);
      end;
      ThemeServices.DrawElement(Handle, ElementDetails, R);
    end
    else
    begin
      case AState of
        abChecked:
          DrawState := DFCS_BUTTONCHECK or DFCS_CHECKED;
        abUnchecked:
          DrawState := DFCS_BUTTONCHECK;
        else // abGrayed
          DrawState := DFCS_BUTTON3STATE or DFCS_CHECKED;
      end;
      if not AEnabled then
        DrawState := DrawState or DFCS_INACTIVE;
      DrawFrameControl(Handle, DrawRect, DFC_BUTTON, DrawState);
    end;

    if Flat then
    begin
      SelectClipRgn(Handle, SaveRgn);
      DeleteObject(SaveRgn);
      { Draw flat rectangle in-place of clipped 3d checkbox above }
      OldBrushStyle := Brush.Style;
      OldBrushColor := Brush.Color;
      OldPenColor := Pen.Color;
      Brush.Style := bsClear;
      Pen.Color := clBtnShadow;
      with DrawRect do
        Rectangle(Left + 1, Top + 1, Right - 1, Bottom - 1);
      Brush.Style := OldBrushStyle;
      Brush.Color := OldBrushColor;
      Pen.Color := OldPenColor;
    end;
  end;
end;

procedure TAlarmCheckListBox.SetChecked(Index: Integer; AChecked: Boolean);
begin
  if AChecked <> GetChecked(Index) then
  begin
    TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).SetChecked(AChecked);
    InvalidateCheck(Index);
  end;
end;

procedure TAlarmCheckListBox.SetItemEnabled(Index: Integer; const Value: Boolean);
begin
  if Value <> GetItemEnabled(Index) then
  begin
    TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).Disabled := not Value;
    InvalidateCheck(Index);
  end;
end;

procedure TAlarmCheckListBox.SetState(Index: Integer; AState: TAlarmBoxState);
begin
  if AState <> GetState(Index) then
  begin
    TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).State := AState;
    InvalidateCheck(Index);
  end;
end;

procedure TAlarmCheckListBox.InvalidateCheck(Index: Integer);
var
  R: TRect;
begin
  if not Header[Index] then
  begin
    R := ItemRect(Index);
    if not UseRightToLeftAlignment then
      R.Right := R.Left + GetCheckWidth
    else
      R.Left := R.Right - GetCheckWidth;
    InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
    UpdateWindow(Handle);
  end;
end;

function TAlarmCheckListBox.GetChecked(Index: Integer): Boolean;
begin
  if HaveWrapper(Index) then
    Result := TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).GetChecked
  else
    Result := False;
end;

function TAlarmCheckListBox.GetItemEnabled(Index: Integer): Boolean;
begin
  if HaveWrapper(Index) then
    Result := not TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).Disabled
  else
    Result := True;
end;

function TAlarmCheckListBox.GetState(Index: Integer): TAlarmBoxState;
begin
  if HaveWrapper(Index) then
    Result := TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).State
  else
    Result := TAlarmCheckListBoxDataWrapper.GetDefaultState;
end;

procedure TAlarmCheckListBox.KeyPress(var Key: Char);
begin
  if (Key = ' ') then
    ToggleClickCheck(ItemIndex);
  inherited KeyPress(Key);
end;

procedure TAlarmCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Index: Integer;
begin
  inherited;
  if Button = mbLeft then
  begin
    Index := ItemAtPos(Point(X,Y),True);
    if (Index <> -1) and GetItemEnabled(Index) then
      if not UseRightToLeftAlignment then
      begin
        if X - ItemRect(Index).Left < GetCheckWidth then
          ToggleClickCheck(Index)
      end
      else
      begin
        Dec(X, ItemRect(Index).Right - GetCheckWidth);
        if (X > 0) and (X < GetCheckWidth) then
          ToggleClickCheck(Index)
      end;
  end;
end;

procedure TAlarmCheckListBox.ToggleClickCheck;
var
  State: TAlarmBoxState;
begin
  if (Index >= 0) and (Index < Items.Count) and GetItemEnabled(Index) then
  begin
    State := Self.State[Index];
    case State of
      abUnchecked:
        if AllowGrayed then State := abGrayed else State := abChecked;
      abChecked: State := abUnchecked;
      abGrayed: State := abChecked;
    end;
    Self.State[Index] := State;
    ClickCheck;
  end;
end;

procedure TAlarmCheckListBox.ClickCheck;
begin
  if Assigned(FOnClickCheck) then FOnClickCheck(Self);
end;

function TAlarmCheckListBox.GetItemData(Index: Integer): LongInt;
begin
  Result := 0;
  if HaveWrapper(Index) then
    Result := TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).FData;
end;

function TAlarmCheckListBox.GetWrapper(Index: Integer): TObject;
begin
  Result := ExtractWrapper(Index);
  if Result = nil then
    Result := CreateWrapper(Index);
end;

function TAlarmCheckListBox.ExtractWrapper(Index: Integer): TObject;
begin
  Result := TAlarmCheckListBoxDataWrapper(inherited GetItemData(Index));
  if LB_ERR = Integer(Result) then
    raise EListError.CreateResFmt(@SListIndexError, [Index]);
  if (Result <> nil) and (not (Result is TAlarmCheckListBoxDataWrapper)) then
    Result := nil;
end;

function TAlarmCheckListBox.InternalGetItemData(Index: Integer): LongInt;
begin
  Result := inherited GetItemData(Index);
end;

procedure TAlarmCheckListBox.InternalSetItemData(Index: Integer; AData: LongInt);
begin
  inherited SetItemData(Index, AData);
end;

function TAlarmCheckListBox.CreateWrapper(Index: Integer): TObject;
begin
  Result := TAlarmCheckListBoxDataWrapper.Create;
  inherited SetItemData(Index, LongInt(Result));
end;

function TAlarmCheckListBox.HaveWrapper(Index: Integer): Boolean;
begin
  Result := ExtractWrapper(Index) <> nil;
end;

procedure TAlarmCheckListBox.SetItemData(Index: Integer; AData: LongInt);
var
  Wrapper: TAlarmCheckListBoxDataWrapper;
begin
  if HaveWrapper(Index) or (AData <> 0) then
  begin
    Wrapper := TAlarmCheckListBoxDataWrapper(GetWrapper(Index));
    Wrapper.FData := AData;
  end;
end;

procedure TAlarmCheckListBox.ResetContent;
var
  I: Integer;
begin
  for I := 0 to Items.Count - 1 do
    if HaveWrapper(I) then
      GetWrapper(I).Free;
  inherited;
end;

procedure TAlarmCheckListBox.DeleteAlarm(Index: Integer);
begin
  if HaveWrapper(Index) then
    GetWrapper(Index).Free;
  inherited;
end;

procedure TAlarmCheckListBox.SetFlat(Value: Boolean);
begin
  if Value <> FFlat then
  begin
    FFlat := Value;
    Invalidate;
  end;
end;

procedure TAlarmCheckListBox.WMDestroy(var Msg: TWMDestroy);
var
  i: Integer;
begin
  for i := 0 to Items.Count -1 do
    ExtractWrapper(i).Free;
  inherited;
end;

function TAlarmCheckListBox.GetHeader(Index: Integer): Boolean;
begin
  if HaveWrapper(Index) then
    Result := TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).Header
  else
    Result := False;
end;

procedure TAlarmCheckListBox.SetHeader(Index: Integer; const Value: Boolean);
begin
  if Value <> GetHeader(Index) then
  begin
    TAlarmCheckListBoxDataWrapper(GetWrapper(Index)).Header := Value;
    InvalidateCheck(Index);
  end;
end;

procedure TAlarmCheckListBox.SetHeaderBackgroundColor(const Value: TColor);
begin
  if Value <> HeaderBackgroundColor then
  begin
    FHeaderBackgroundColor := Value;
    Invalidate;
  end;
end;

procedure TAlarmCheckListBox.SetHeaderColor(const Value: TColor);
begin
  if Value <> HeaderColor then
  begin
    FHeaderColor := Value;
    Invalidate;
  end;
end;

{ TCustomAlarmControl }

procedure TCustomAlarmControl.MoveSelection(
  Destination: TCustomAlarmControl);
begin
  CopySelection(Destination);
  DeleteSelected;
end;


initialization
  GetCheckSize;
end.

i dont think its calling the draw options but im new to Delphi and dont know too much about it

thanks in advanced for anyone that can help

Edited 3 Years Ago by Dani: Formatting fixed

you write a lot in this component and it is hard to take the entire code and understand, it take a lot of time.

what i suggest to you. if your component can be compiled then install it and make a simple project. run the project step by step and see how your component is working. you wrote the code and in this way you will be able to identify where is the problem

best regards,

This article has been dead for over six months. Start a new discussion instead.