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