david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
2022 lines
56 KiB
ObjectPascal
2022 lines
56 KiB
ObjectPascal
{-----------------------------------------------------------------------------
|
|
The contents of this file are subject to the Mozilla Public License
|
|
Version 1.1 (the "License"); you may not use this file except in compliance
|
|
with the License. You may obtain a copy of the License at
|
|
http://www.mozilla.org/MPL/MPL-1.1.html
|
|
|
|
Software distributed under the License is distributed on an "AS IS" basis,
|
|
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
|
|
the specific language governing rights and limitations under the License.
|
|
|
|
The Original Code is: JvxCheckListBox.pas, released on 2003-10-19.
|
|
|
|
The Initial Developers of the Original Code are: Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 1997, 1998 Fedor Koshevnikov, Igor Pavluk and Serge Korolev
|
|
Copyright (c) 2001,2002 SGB Software
|
|
All Rights Reserved.
|
|
|
|
Contributor(s):
|
|
Polaris Software
|
|
Peter Thornqvist [peter3 at sourceforge dot net]
|
|
Andreas Hausladen (XP theming)
|
|
|
|
Changes:
|
|
2003-10-19:
|
|
* Moved TJvxCustomListBox and TJvxCheckListBox from JvxCtrls to this unit
|
|
|
|
2004-10-07:
|
|
* Changed by hofi
|
|
TJvxCheckListBox
|
|
procedure DrawCheck(R: TRect; AState: TCheckBoxState; Enabled: Boolean);
|
|
now protected to support possible call from derived classes.
|
|
|
|
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
|
|
located at http://jvcl.delphi-jedi.org
|
|
|
|
Known Issues:
|
|
-----------------------------------------------------------------------------}
|
|
// $Id: JvxCheckListBox.pas 12579 2009-10-26 19:59:53Z ahuser $
|
|
|
|
unit JvxCheckListBox;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
Windows, Messages, Classes, Controls, Graphics, StdCtrls, Forms,
|
|
Types, RTLConsts,
|
|
JvAppStorage, JvFormPlacement, JvComponent;
|
|
|
|
type
|
|
TGetItemWidthEvent = procedure(Control: TWinControl; Index: Integer;
|
|
var Width: Integer) of object;
|
|
|
|
TJvxCustomListBox = class(TJvWinControl)
|
|
private
|
|
FItems: TStrings;
|
|
FBorderStyle: TBorderStyle;
|
|
FCanvas: TControlCanvas;
|
|
FColumns: Integer;
|
|
FItemHeight: Integer;
|
|
FStyle: TListBoxStyle;
|
|
FIntegralHeight: Boolean;
|
|
FMultiSelect: Boolean;
|
|
FSorted: Boolean;
|
|
FExtendedSelect: Boolean;
|
|
FTabWidth: Integer;
|
|
FSaveItems: TStringList;
|
|
FSaveTopIndex: Integer;
|
|
FSaveItemIndex: Integer;
|
|
FAutoScroll: Boolean;
|
|
FGraySelection: Boolean;
|
|
FMaxItemWidth: Integer;
|
|
FOnDrawItem: TDrawItemEvent;
|
|
FOnMeasureItem: TMeasureItemEvent;
|
|
FOnGetItemWidth: TGetItemWidthEvent;
|
|
procedure ResetHorizontalExtent;
|
|
procedure SetHorizontalExtent;
|
|
function GetCanvas: TCanvas;
|
|
function GetAutoScroll: Boolean;
|
|
function GetItemHeight: Integer; virtual;
|
|
function GetItemIndex: Integer;
|
|
function GetSelCount: Integer;
|
|
function GetSelected(Index: Integer): Boolean;
|
|
function GetTopIndex: Integer;
|
|
procedure SetAutoScroll(Value: Boolean);
|
|
procedure SetBorderStyle(Value: TBorderStyle);
|
|
procedure SetColumnWidth;
|
|
procedure SetColumns(Value: Integer);
|
|
procedure SetExtendedSelect(Value: Boolean);
|
|
procedure SetIntegralHeight(Value: Boolean);
|
|
procedure SetItemHeight(Value: Integer);
|
|
procedure SetItemIndex(Value: Integer);
|
|
procedure SetMultiSelect(Value: Boolean);
|
|
procedure SetSelected(Index: Integer; Value: Boolean);
|
|
procedure SetSorted(Value: Boolean);
|
|
procedure SetStyle(Value: TListBoxStyle);
|
|
procedure SetTabWidth(Value: Integer);
|
|
procedure SetTopIndex(Value: Integer);
|
|
procedure SetGraySelection(Value: Boolean);
|
|
procedure SetOnDrawItem(Value: TDrawItemEvent);
|
|
procedure SetOnGetItemWidth(Value: TGetItemWidthEvent);
|
|
procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;
|
|
procedure CNCommand(var Msg: TWMCommand); message CN_COMMAND;
|
|
procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
|
|
procedure CNMeasureItem(var Msg: TWMMeasureItem); message CN_MEASUREITEM;
|
|
procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;
|
|
procedure WMNCHitTest(var Msg: TWMNCHitTest); message WM_NCHITTEST;
|
|
procedure CMCtl3DChanged(var Msg: TMessage); message CM_CTL3DCHANGED;
|
|
protected
|
|
procedure BoundsChanged; override;
|
|
procedure FocusKilled(NextWnd: THandle); override;
|
|
procedure FocusSet(PrevWnd: THandle); override;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
function CreateItemList: TStrings; virtual;
|
|
function GetItemWidth(Index: Integer): Integer; virtual;
|
|
procedure WndProc(var Msg: TMessage); override;
|
|
procedure DragCanceled; override;
|
|
procedure DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState); virtual;
|
|
procedure MeasureItem(Index: Integer; var Height: Integer); virtual;
|
|
function GetItemData(Index: Integer): Longint; dynamic;
|
|
procedure SetItemData(Index: Integer; AData: Longint); dynamic;
|
|
function GetItems: TStrings; virtual;
|
|
procedure SetItems(Value: TStrings); virtual;
|
|
procedure ResetContent; dynamic;
|
|
procedure DeleteString(Index: Integer); dynamic;
|
|
property AutoScroll: Boolean read GetAutoScroll write SetAutoScroll default False;
|
|
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 GraySelection: Boolean read FGraySelection write SetGraySelection default False;
|
|
property IntegralHeight: Boolean read FIntegralHeight write SetIntegralHeight default False;
|
|
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
|
|
property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
|
|
property ParentColor default False;
|
|
property Sorted: Boolean read FSorted write SetSorted default False;
|
|
property Style: TListBoxStyle read FStyle write SetStyle default lbStandard;
|
|
property TabWidth: Integer read FTabWidth write SetTabWidth default 0;
|
|
property OnDrawItem: TDrawItemEvent read FOnDrawItem write SetOnDrawItem;
|
|
property OnMeasureItem: TMeasureItemEvent read FOnMeasureItem write FOnMeasureItem;
|
|
property OnGetItemWidth: TGetItemWidthEvent read FOnGetItemWidth write SetOnGetItemWidth;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure DefaultDrawText(X, Y: Integer; const S: string);
|
|
function ItemAtPos(Pos: TPoint; Existing: Boolean): Integer;
|
|
function ItemRect(Index: Integer): TRect;
|
|
property Canvas: TCanvas read GetCanvas;
|
|
property Items: TStrings read GetItems write SetItems;
|
|
property ItemIndex: Integer read GetItemIndex write SetItemIndex;
|
|
property SelCount: Integer read GetSelCount;
|
|
property Selected[Index: Integer]: Boolean read GetSelected write SetSelected;
|
|
property TopIndex: Integer read GetTopIndex write SetTopIndex;
|
|
end;
|
|
|
|
TCheckKind = (ckCheckBoxes, ckRadioButtons, ckCheckMarks);
|
|
TChangeStateEvent = procedure(Sender: TObject; Index: Integer) of object;
|
|
|
|
TJvxCheckListBox = class(TJvxCustomListBox)
|
|
private
|
|
FAllowGrayed: Boolean;
|
|
FCheckKind: TCheckKind;
|
|
FSaveStates: TList;
|
|
FDrawBitmap: TBitmap;
|
|
FCheckWidth, FCheckHeight: Integer;
|
|
FReserved: Integer;
|
|
FInUpdateStates: Boolean;
|
|
FIniLink: TJvIniLink;
|
|
FOnClickCheck: TNotifyEvent;
|
|
FOnStateChange: TChangeStateEvent;
|
|
procedure ResetItemHeight;
|
|
function GetItemHeight: Integer; override;
|
|
procedure SetCheckKind(Value: TCheckKind);
|
|
procedure SetChecked(Index: Integer; AChecked: Boolean);
|
|
function GetChecked(Index: Integer): Boolean;
|
|
procedure SetState(Index: Integer; AState: TCheckBoxState);
|
|
function GetState(Index: Integer): TCheckBoxState;
|
|
procedure SetItemEnabled(Index: Integer; Value: Boolean);
|
|
function GetItemEnabled(Index: Integer): Boolean;
|
|
function GetAllowGrayed: Boolean;
|
|
procedure ToggleClickCheck(Index: Integer);
|
|
procedure InvalidateCheck(Index: Integer);
|
|
procedure InvalidateItem(Index: Integer);
|
|
function CreateCheckObject(Index: Integer): TObject;
|
|
function FindCheckObject(Index: Integer): TObject;
|
|
function GetCheckObject(Index: Integer): TObject;
|
|
function IsCheckObject(Index: Integer): Boolean;
|
|
procedure ReadVersion(Reader: TReader);
|
|
procedure WriteVersion(Writer: TWriter);
|
|
procedure ReadCheckData(Reader: TReader);
|
|
procedure WriteCheckData(Writer: TWriter);
|
|
function GetStorage: TJvFormPlacement;
|
|
procedure SetStorage(Value: TJvFormPlacement);
|
|
procedure IniSave(Sender: TObject);
|
|
procedure IniLoad(Sender: TObject);
|
|
procedure UpdateCheckStates;
|
|
function GetCheckedIndex: Integer;
|
|
procedure SetCheckedIndex(Value: Integer);
|
|
procedure CNDrawItem(var Msg: TWMDrawItem); message CN_DRAWITEM;
|
|
protected
|
|
procedure FontChanged; override;
|
|
function CreateItemList: TStrings; override;
|
|
procedure DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState); override;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
function GetItemWidth(Index: Integer): Integer; override;
|
|
function GetItemData(Index: Integer): Longint; override;
|
|
procedure SetItemData(Index: Integer; AData: Longint); override;
|
|
procedure KeyPress(var Key: Char); override;
|
|
procedure Loaded; override;
|
|
procedure DrawCheck(R: TRect; AState: TCheckBoxState; Enabled: Boolean);
|
|
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer); override;
|
|
procedure ResetContent; override;
|
|
procedure DeleteString(Index: Integer); override;
|
|
procedure ClickCheck; dynamic;
|
|
procedure ChangeItemState(Index: Integer); dynamic;
|
|
procedure CreateParams(var Params: TCreateParams); override;
|
|
procedure CreateWnd; override;
|
|
procedure DestroyWnd; override;
|
|
procedure WMDestroy(var Msg: TWMDestroy); message WM_DESTROY;
|
|
function GetCheckWidth: Integer;
|
|
procedure SetItems(Value: TStrings); override;
|
|
procedure InternalLoad(const Section: string);
|
|
procedure InternalSave(const Section: string);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure LoadFromAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
|
|
procedure SaveToAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
|
|
procedure Load;
|
|
procedure Save;
|
|
procedure ApplyState(AState: TCheckBoxState; EnabledOnly: Boolean);
|
|
property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
|
|
property State[Index: Integer]: TCheckBoxState read GetState write SetState;
|
|
property EnabledItem[Index: Integer]: Boolean read GetItemEnabled write SetItemEnabled;
|
|
published
|
|
property AllowGrayed: Boolean read GetAllowGrayed write FAllowGrayed default False;
|
|
property CheckKind: TCheckKind read FCheckKind write SetCheckKind default ckCheckBoxes;
|
|
property CheckedIndex: Integer read GetCheckedIndex write SetCheckedIndex default -1;
|
|
property IniStorage: TJvFormPlacement read GetStorage write SetStorage;
|
|
property Align;
|
|
property AutoScroll default True;
|
|
property BorderStyle;
|
|
property Color;
|
|
property Columns;
|
|
property DragCursor;
|
|
property DragMode;
|
|
property Enabled;
|
|
property ExtendedSelect;
|
|
property Font;
|
|
property GraySelection;
|
|
property Anchors;
|
|
property BiDiMode;
|
|
property Constraints;
|
|
property DragKind;
|
|
property ParentBiDiMode;
|
|
property ImeMode;
|
|
property ImeName;
|
|
property IntegralHeight;
|
|
property ItemHeight;
|
|
property Items stored False;
|
|
property MultiSelect;
|
|
property ParentColor;
|
|
property ParentFont;
|
|
property ParentShowHint;
|
|
property PopupMenu;
|
|
property ShowHint;
|
|
property Sorted;
|
|
property Style;
|
|
property TabOrder;
|
|
property TabStop default True;
|
|
property TabWidth;
|
|
property Visible;
|
|
property OnStateChange: TChangeStateEvent read FOnStateChange write FOnStateChange;
|
|
property OnClickCheck: TNotifyEvent read FOnClickCheck write FOnClickCheck;
|
|
property OnClick;
|
|
property OnDblClick;
|
|
property OnDragDrop;
|
|
property OnDragOver;
|
|
property OnDrawItem;
|
|
property OnEndDrag;
|
|
property OnEnter;
|
|
property OnExit;
|
|
property OnGetItemWidth;
|
|
property OnKeyDown;
|
|
property OnKeyPress;
|
|
property OnKeyUp;
|
|
property OnMeasureItem;
|
|
property OnMouseDown;
|
|
property OnMouseMove;
|
|
property OnMouseUp;
|
|
property OnStartDrag;
|
|
property OnContextPopup;
|
|
property OnMouseWheelDown;
|
|
property OnMouseWheelUp;
|
|
property OnEndDock;
|
|
property OnStartDock;
|
|
end;
|
|
|
|
const
|
|
clbDefaultState = cbUnchecked;
|
|
clbDefaultEnabled = True;
|
|
|
|
function CheckBitmap: TBitmap;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jvcl.svn.sourceforge.net/svnroot/jvcl/tags/JVCL3_39/run/JvxCheckListBox.pas $';
|
|
Revision: '$Revision: 12579 $';
|
|
Date: '$Date: 2009-10-26 20:59:53 +0100 (lun., 26 oct. 2009) $';
|
|
LogPath: 'JVCL\run'
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
{$R JvxCheckListBox.res}
|
|
|
|
uses
|
|
SysUtils, Consts, Math,
|
|
JvConsts, JvJVCLUtils, JvThemes;
|
|
|
|
//=== { TJvListBoxStrings } ==================================================
|
|
|
|
type
|
|
TJvListBoxStrings = class(TStrings)
|
|
private
|
|
ListBox: TJvxCustomListBox;
|
|
protected
|
|
function Get(Index: Integer): string; 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 S: string): Integer; override;
|
|
procedure Clear; override;
|
|
procedure Delete(Index: Integer); override;
|
|
procedure Insert(Index: Integer; const S: string); override;
|
|
end;
|
|
|
|
function TJvListBoxStrings.GetCount: Integer;
|
|
begin
|
|
Result := SendMessage(ListBox.Handle, LB_GETCOUNT, 0, 0);
|
|
end;
|
|
|
|
function TJvListBoxStrings.Get(Index: Integer): string;
|
|
var
|
|
Len: Integer;
|
|
Text: array [0..4095] of Char;
|
|
begin
|
|
Len := SendMessage(ListBox.Handle, LB_GETTEXT, Index, LPARAM(@Text));
|
|
if Len < 0 then
|
|
Error(SListIndexError, Index);
|
|
SetString(Result, Text, Len);
|
|
end;
|
|
|
|
function TJvListBoxStrings.GetObject(Index: Integer): TObject;
|
|
begin
|
|
Result := TObject(ListBox.GetItemData(Index));
|
|
if Longint(Result) = LB_ERR then
|
|
Error(SListIndexError, Index);
|
|
end;
|
|
|
|
procedure TJvListBoxStrings.PutObject(Index: Integer; AObject: TObject);
|
|
begin
|
|
ListBox.SetItemData(Index, Longint(AObject));
|
|
end;
|
|
|
|
function TJvListBoxStrings.Add(const S: string): Integer;
|
|
begin
|
|
Result := SendMessage(ListBox.Handle, LB_ADDSTRING, 0, LPARAM(PChar(S)));
|
|
if Result < 0 then
|
|
raise EOutOfResources.CreateRes(@SInsertLineError);
|
|
end;
|
|
|
|
procedure TJvListBoxStrings.Insert(Index: Integer; const S: string);
|
|
begin
|
|
if SendMessage(ListBox.Handle, LB_INSERTSTRING, Index, LPARAM(PChar(S))) < 0 then
|
|
raise EOutOfResources.CreateRes(@SInsertLineError);
|
|
end;
|
|
|
|
procedure TJvListBoxStrings.Delete(Index: Integer);
|
|
begin
|
|
ListBox.DeleteString(Index);
|
|
end;
|
|
|
|
procedure TJvListBoxStrings.Clear;
|
|
begin
|
|
ListBox.ResetContent;
|
|
end;
|
|
|
|
procedure TJvListBoxStrings.SetUpdateState(Updating: Boolean);
|
|
begin
|
|
SendMessage(ListBox.Handle, WM_SETREDRAW, Ord(not Updating), 0);
|
|
if not Updating then
|
|
ListBox.Refresh;
|
|
end;
|
|
|
|
//=== { TJvxCustomListBox } ==================================================
|
|
|
|
{ TJvxCustomListBox implementation copied from STDCTRLS.PAS and modified }
|
|
|
|
procedure ListIndexError(Index: Integer);
|
|
|
|
function ReturnAddr: Pointer;
|
|
asm
|
|
MOV EAX,[EBP+4]
|
|
end;
|
|
|
|
begin
|
|
raise EStringListError.CreateResFmt(@SListIndexError, [Index]) at ReturnAddr;
|
|
end;
|
|
|
|
constructor TJvxCustomListBox.Create(AOwner: TComponent);
|
|
const
|
|
ListBoxStyle = [csSetCaption, csDoubleClicks];
|
|
begin
|
|
inherited Create(AOwner);
|
|
ControlStyle := ListBoxStyle;
|
|
Width := 121;
|
|
Height := 97;
|
|
TabStop := True;
|
|
ParentColor := False;
|
|
FItems := CreateItemList;
|
|
TJvListBoxStrings(FItems).ListBox := Self;
|
|
FCanvas := TControlCanvas.Create;
|
|
FCanvas.Control := Self;
|
|
FItemHeight := 16;
|
|
FBorderStyle := bsSingle;
|
|
FExtendedSelect := True;
|
|
end;
|
|
|
|
destructor TJvxCustomListBox.Destroy;
|
|
begin
|
|
// (ahuser) moved inherited to the top otherwise it will raise an AV in csDesigning
|
|
inherited Destroy;
|
|
FCanvas.Free;
|
|
FItems.Free;
|
|
FSaveItems.Free;
|
|
end;
|
|
|
|
function TJvxCustomListBox.CreateItemList: TStrings;
|
|
begin
|
|
Result := TJvListBoxStrings.Create;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetCanvas: TCanvas;
|
|
begin
|
|
Result := FCanvas;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetItemData(Index: Integer): Longint;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETITEMDATA, Index, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetItemData(Index: Integer; AData: Longint);
|
|
begin
|
|
SendMessage(Handle, LB_SETITEMDATA, Index, AData);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.DeleteString(Index: Integer);
|
|
begin
|
|
SendMessage(Handle, LB_DELETESTRING, Index, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetHorizontalExtent;
|
|
begin
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, FMaxItemWidth, 0);
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetItemWidth(Index: Integer): Integer;
|
|
var
|
|
ATabWidth: array [0..0] of Integer;
|
|
S: string;
|
|
begin
|
|
Result := 0;
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (Style <> lbStandard) and Assigned(FOnGetItemWidth) and
|
|
Assigned(FOnDrawItem) then
|
|
FOnGetItemWidth(Self, Index, Result)
|
|
else
|
|
begin
|
|
S := Items[Index] + 'x';
|
|
if TabWidth > 0 then
|
|
begin
|
|
{if (FTabChar > #0) then
|
|
for I := 1 to Length(S) do
|
|
if S[I] = FTabChar then S[I] := #9;}
|
|
ATabWidth[0] := Round((TabWidth * FCanvas.TextWidth('0')) * 0.25);
|
|
Result :=
|
|
LoWord(GetTabbedTextExtent(FCanvas.Handle, PChar(S), Length(S), 1, ATabWidth));
|
|
end
|
|
else
|
|
Result := FCanvas.TextWidth(S);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.ResetHorizontalExtent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FMaxItemWidth := 0;
|
|
for I := 0 to Items.Count - 1 do
|
|
FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(I));
|
|
SetHorizontalExtent;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.ResetContent;
|
|
begin
|
|
SendMessage(Handle, LB_RESETCONTENT, 0, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetColumnWidth;
|
|
begin
|
|
if FColumns > 0 then
|
|
SendMessage(Handle, LB_SETCOLUMNWIDTH, (Width + FColumns - 3) div FColumns, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.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 TJvxCustomListBox.GetItemIndex: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETCURSEL, 0, 0);
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetSelCount: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETSELCOUNT, 0, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetItemIndex(Value: Integer);
|
|
begin
|
|
if GetItemIndex <> Value then
|
|
SendMessage(Handle, LB_SETCURSEL, Value, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetExtendedSelect(Value: Boolean);
|
|
begin
|
|
if Value <> FExtendedSelect then
|
|
begin
|
|
FExtendedSelect := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetIntegralHeight(Value: Boolean);
|
|
begin
|
|
if Value <> FIntegralHeight then
|
|
begin
|
|
FIntegralHeight := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetAutoScroll: Boolean;
|
|
begin
|
|
Result := FAutoScroll and (Columns = 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetOnDrawItem(Value: TDrawItemEvent);
|
|
begin
|
|
if Assigned(FOnDrawItem) <> Assigned(Value) then
|
|
begin
|
|
FOnDrawItem := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then
|
|
if AutoScroll then
|
|
ResetHorizontalExtent
|
|
else
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end
|
|
else
|
|
FOnDrawItem := Value;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetOnGetItemWidth(Value: TGetItemWidthEvent);
|
|
begin
|
|
if Assigned(FOnGetItemWidth) <> Assigned(Value) then
|
|
begin
|
|
FOnGetItemWidth := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then
|
|
if AutoScroll then
|
|
ResetHorizontalExtent
|
|
else
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end
|
|
else
|
|
FOnGetItemWidth := Value;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetAutoScroll(Value: Boolean);
|
|
begin
|
|
if AutoScroll <> Value then
|
|
begin
|
|
FAutoScroll := Value;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
if HandleAllocated then
|
|
if AutoScroll then
|
|
ResetHorizontalExtent
|
|
else
|
|
SendMessage(Handle, LB_SETHORIZONTALEXTENT, 0, 0);
|
|
end;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetItemHeight: Integer;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
Result := FItemHeight;
|
|
if HandleAllocated and (FStyle = lbStandard) then
|
|
begin
|
|
Perform(LB_GETITEMRECT, 0, LPARAM(@R));
|
|
Result := R.Bottom - R.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetItemHeight(Value: Integer);
|
|
begin
|
|
if (FItemHeight <> Value) and (Value > 0) then
|
|
begin
|
|
FItemHeight := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetTabWidth(Value: Integer);
|
|
begin
|
|
if Value < 0 then
|
|
Value := 0;
|
|
if FTabWidth <> Value then
|
|
begin
|
|
FTabWidth := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetMultiSelect(Value: Boolean);
|
|
begin
|
|
if FMultiSelect <> Value then
|
|
begin
|
|
FMultiSelect := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetSelected(Index: Integer): Boolean;
|
|
var
|
|
R: Longint;
|
|
begin
|
|
R := SendMessage(Handle, LB_GETSEL, Index, 0);
|
|
if R = LB_ERR then
|
|
ListIndexError(Index);
|
|
Result := LongBool(R);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetSelected(Index: Integer; Value: Boolean);
|
|
begin
|
|
if MultiSelect then
|
|
begin
|
|
if SendMessage(Handle, LB_SETSEL, Ord(Value), Index) = LB_ERR then
|
|
ListIndexError(Index);
|
|
end
|
|
else
|
|
begin
|
|
if Value then
|
|
SetItemIndex(Index)
|
|
else
|
|
if ItemIndex = Index then
|
|
SetItemIndex(-1);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetSorted(Value: Boolean);
|
|
begin
|
|
if FSorted <> Value then
|
|
begin
|
|
FSorted := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetStyle(Value: TListBoxStyle);
|
|
begin
|
|
if FStyle <> Value then
|
|
begin
|
|
FStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetTopIndex: Integer;
|
|
begin
|
|
Result := SendMessage(Handle, LB_GETTOPINDEX, 0, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetBorderStyle(Value: TBorderStyle);
|
|
begin
|
|
if FBorderStyle <> Value then
|
|
begin
|
|
FBorderStyle := Value;
|
|
RecreateWnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetTopIndex(Value: Integer);
|
|
begin
|
|
if GetTopIndex <> Value then
|
|
SendMessage(Handle, LB_SETTOPINDEX, Value, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetGraySelection(Value: Boolean);
|
|
begin
|
|
if FGraySelection <> Value then
|
|
begin
|
|
FGraySelection := Value;
|
|
if not Focused then
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCustomListBox.GetItems: TStrings;
|
|
begin
|
|
Result := FItems;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.SetItems(Value: TStrings);
|
|
begin
|
|
Items.Assign(Value);
|
|
end;
|
|
|
|
function TJvxCustomListBox.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, LPARAM(@ItemRect));
|
|
if PtInRect(ItemRect, Pos) then
|
|
Exit;
|
|
Inc(Result);
|
|
end;
|
|
if not Existing then
|
|
Exit;
|
|
end;
|
|
Result := -1;
|
|
end;
|
|
|
|
function TJvxCustomListBox.ItemRect(Index: Integer): TRect;
|
|
var
|
|
Count: Integer;
|
|
begin
|
|
Count := Items.Count;
|
|
if (Index = 0) or (Index < Count) then
|
|
Perform(LB_GETITEMRECT, Index, LPARAM(@Result))
|
|
else
|
|
if Index = Count then
|
|
begin
|
|
Perform(LB_GETITEMRECT, Index - 1, LPARAM(@Result));
|
|
OffsetRect(Result, 0, Result.Bottom - Result.Top);
|
|
end
|
|
else
|
|
Result := Rect(0, 0, 0, 0);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.CreateParams(var Params: TCreateParams);
|
|
type
|
|
PSelects = ^TSelects;
|
|
TSelects = array [Boolean] of Longword;
|
|
const
|
|
BorderStyles: array [TBorderStyle] of Longword = (0, WS_BORDER);
|
|
Styles: array [TListBoxStyle] of Longword =
|
|
(0, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWVARIABLE, LBS_OWNERDRAWFIXED, LBS_OWNERDRAWFIXED);
|
|
Sorteds: TSelects = (0, LBS_SORT);
|
|
MultiSelects: TSelects = (0, LBS_MULTIPLESEL);
|
|
ExtendSelects: TSelects = (0, LBS_EXTENDEDSEL);
|
|
IntegralHeights: TSelects = (LBS_NOINTEGRALHEIGHT, 0);
|
|
MultiColumns: TSelects = (0, LBS_MULTICOLUMN);
|
|
TabStops: TSelects = (0, LBS_USETABSTOPS);
|
|
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 LBS_HASSTRINGS 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 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 (CS_HREDRAW or CS_VREDRAW);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.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
|
|
begin
|
|
SendMessage(Handle, LB_SETTABSTOPS, 1, LPARAM(@FTabWidth));
|
|
end;
|
|
SetColumnWidth;
|
|
if FSaveItems <> nil then
|
|
begin
|
|
FItems.Assign(FSaveItems);
|
|
SetTopIndex(FSaveTopIndex);
|
|
SetItemIndex(FSaveItemIndex);
|
|
FSaveItems.Free;
|
|
FSaveItems := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.DestroyWnd;
|
|
begin
|
|
if FItems.Count > 0 then
|
|
begin
|
|
FSaveItems := TStringList.Create;
|
|
FSaveItems.Assign(FItems);
|
|
FSaveTopIndex := GetTopIndex;
|
|
FSaveItemIndex := GetItemIndex;
|
|
end;
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.WndProc(var Msg: TMessage);
|
|
begin
|
|
if AutoScroll then
|
|
begin
|
|
case Msg.Msg of
|
|
LB_ADDSTRING, LB_INSERTSTRING:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
FMaxItemWidth := Max(FMaxItemWidth, GetItemWidth(Msg.Result));
|
|
SetHorizontalExtent;
|
|
Exit;
|
|
end;
|
|
LB_DELETESTRING:
|
|
begin
|
|
if GetItemWidth(Msg.WParam) >= FMaxItemWidth then
|
|
begin
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Msg);
|
|
ResetHorizontalExtent;
|
|
end
|
|
else
|
|
inherited WndProc(Msg);
|
|
Exit;
|
|
end;
|
|
LB_RESETCONTENT:
|
|
begin
|
|
FMaxItemWidth := 0;
|
|
SetHorizontalExtent;
|
|
Perform(WM_HSCROLL, SB_TOP, 0);
|
|
inherited WndProc(Msg);
|
|
Exit;
|
|
end;
|
|
WM_SETFONT:
|
|
begin
|
|
inherited WndProc(Msg);
|
|
if not (csDestroying in ComponentState) then
|
|
begin
|
|
FCanvas.Font.Assign(Self.Font);
|
|
ResetHorizontalExtent;
|
|
end;
|
|
Exit;
|
|
end;
|
|
end;
|
|
end;
|
|
{for auto drag mode, let listbox handle itself, instead of TControl}
|
|
if not (csDesigning in ComponentState) and ((Msg.Msg = WM_LBUTTONDOWN) or
|
|
(Msg.Msg = WM_LBUTTONDBLCLK)) and not Dragging then
|
|
begin
|
|
if DragMode = dmAutomatic then
|
|
begin
|
|
if IsControlMouseMsg(TWMMouse(Msg)) then
|
|
Exit;
|
|
ControlState := ControlState + [csLButtonDown];
|
|
Dispatch(Msg); {overrides TControl's BeginDrag}
|
|
Exit;
|
|
end;
|
|
end;
|
|
inherited WndProc(Msg);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.WMLButtonDown(var Msg: TWMLButtonDown);
|
|
var
|
|
ItemNo: Integer;
|
|
ShiftState: TShiftState;
|
|
begin
|
|
ShiftState := KeysToShiftState(Msg.Keys);
|
|
if (DragMode = dmAutomatic) and FMultiSelect then
|
|
begin
|
|
if not (ssShift in ShiftState) or (ssCtrl in ShiftState) then
|
|
begin
|
|
ItemNo := ItemAtPos(SmallPointToPoint(Msg.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 TJvxCustomListBox.WMNCHitTest(var Msg: TWMNCHitTest);
|
|
begin
|
|
if csDesigning in ComponentState then
|
|
DefaultHandler(Msg)
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.CNCommand(var Msg: TWMCommand);
|
|
begin
|
|
case Msg.NotifyCode of
|
|
LBN_SELCHANGE:
|
|
begin
|
|
inherited Changed;
|
|
Click;
|
|
end;
|
|
LBN_DBLCLK:
|
|
DblClick;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.WMPaint(var Msg: 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 := Msg.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(Msg.DC, R);
|
|
H := Height;
|
|
W := Width;
|
|
while Y < H do
|
|
begin
|
|
MeasureItemStruct.itemID := I;
|
|
if I < Items.Count then
|
|
MeasureItemStruct.itemData := Longint(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 Msg.DC <> 0 then
|
|
PaintListBox
|
|
else
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.BoundsChanged;
|
|
begin
|
|
inherited BoundsChanged;
|
|
SetColumnWidth;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.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 TJvxCustomListBox.DefaultDrawText(X, Y: Integer; const S: string);
|
|
var
|
|
ATabWidth: array [0..0] of Longint;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
FCanvas.UpdateTextFlags;
|
|
if FTabWidth = 0 then
|
|
FCanvas.TextOut(X, Y, S)
|
|
else
|
|
begin
|
|
ATabWidth[0] := Round((TabWidth * FCanvas.TextWidth('0')) * 0.25);
|
|
TabbedTextOut(FCanvas.Handle, X, Y, PChar(S), Length(S), 1, ATabWidth, X);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState);
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if Assigned(FOnDrawItem) then
|
|
FOnDrawItem(Self, Index, Rect, State)
|
|
else
|
|
begin
|
|
FCanvas.FillRect(Rect);
|
|
if Index < Items.Count then
|
|
begin
|
|
if not UseRightToLeftAlignment then
|
|
Inc(Rect.Left, 2)
|
|
else
|
|
Dec(Rect.Right, 2);
|
|
DefaultDrawText(Rect.Left,
|
|
Max(Rect.Top, (Rect.Bottom + Rect.Top - CanvasMaxTextHeight(FCanvas)) div 2),
|
|
Items[Index]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.MeasureItem(Index: Integer; var Height: Integer);
|
|
begin
|
|
if Assigned(FOnMeasureItem) then
|
|
FOnMeasureItem(Self, Index, Height);
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.CNDrawItem(var Msg: TWMDrawItem);
|
|
var
|
|
State: TOwnerDrawState;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
with Msg.DrawItemStruct^ do
|
|
begin
|
|
State := TOwnerDrawState(LoWord(itemState));
|
|
FCanvas.Handle := HDC;
|
|
FCanvas.Font := Font;
|
|
FCanvas.Brush := Brush;
|
|
if (Integer(itemID) >= 0) and (odSelected in State) then
|
|
begin
|
|
with FCanvas do
|
|
if not (csDesigning in ComponentState) and FGraySelection and
|
|
not Focused then
|
|
begin
|
|
Brush.Color := clBtnFace;
|
|
if ColorToRGB(Font.Color) = ColorToRGB(clBtnFace) then
|
|
Font.Color := clBtnText;
|
|
end
|
|
else
|
|
begin
|
|
Brush.Color := clHighlight;
|
|
Font.Color := clHighlightText
|
|
end;
|
|
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 TJvxCustomListBox.CNMeasureItem(var Msg: TWMMeasureItem);
|
|
var
|
|
LItemHeight: Integer;
|
|
begin
|
|
with Msg.MeasureItemStruct^ do
|
|
begin
|
|
LItemHeight := FItemHeight;
|
|
if FStyle = lbOwnerDrawVariable then
|
|
MeasureItem(itemID, LItemHeight);
|
|
itemHeight := UINT(LItemHeight);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.FocusKilled(NextWnd: THandle);
|
|
begin
|
|
inherited FocusKilled(NextWnd);
|
|
if FGraySelection and MultiSelect and (SelCount > 1) then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.FocusSet(PrevWnd: THandle);
|
|
begin
|
|
inherited FocusSet(PrevWnd);
|
|
if FGraySelection and MultiSelect and (SelCount > 1) then
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TJvxCustomListBox.CMCtl3DChanged(var Msg: TMessage);
|
|
begin
|
|
if FBorderStyle = bsSingle then
|
|
RecreateWnd;
|
|
inherited;
|
|
end;
|
|
|
|
//=== { TJvCheckListBoxItem } ================================================
|
|
|
|
type
|
|
TJvCheckListBoxItem = class(TObject)
|
|
private
|
|
FData: Longint;
|
|
FState: TCheckBoxState;
|
|
FEnabled: Boolean;
|
|
function GetChecked: Boolean;
|
|
public
|
|
constructor Create;
|
|
property Checked: Boolean read GetChecked;
|
|
property Enabled: Boolean read FEnabled write FEnabled;
|
|
property State: TCheckBoxState read FState write FState;
|
|
end;
|
|
|
|
constructor TJvCheckListBoxItem.Create;
|
|
begin
|
|
inherited Create;
|
|
FState := clbDefaultState;
|
|
FEnabled := clbDefaultEnabled;
|
|
end;
|
|
|
|
function TJvCheckListBoxItem.GetChecked: Boolean;
|
|
begin
|
|
Result := FState = cbChecked;
|
|
end;
|
|
|
|
//=== { TJvCheckListBoxStrings } =============================================
|
|
|
|
type
|
|
TJvCheckListBoxStrings = class(TJvListBoxStrings)
|
|
public
|
|
procedure Exchange(Index1, Index2: Integer); override;
|
|
procedure Move(CurIndex, NewIndex: Integer); override;
|
|
end;
|
|
|
|
procedure TJvCheckListBoxStrings.Exchange(Index1, Index2: Integer);
|
|
var
|
|
TempEnabled1, TempEnabled2: Boolean;
|
|
TempState1, TempState2: TCheckBoxState;
|
|
begin
|
|
with TJvxCheckListBox(ListBox) do
|
|
begin
|
|
TempState1 := State[Index1];
|
|
TempEnabled1 := EnabledItem[Index1];
|
|
TempState2 := State[Index2];
|
|
TempEnabled2 := EnabledItem[Index2];
|
|
inherited Exchange(Index1, Index2);
|
|
State[Index1] := TempState2;
|
|
EnabledItem[Index1] := TempEnabled2;
|
|
State[Index2] := TempState1;
|
|
EnabledItem[Index2] := TempEnabled1;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvCheckListBoxStrings.Move(CurIndex, NewIndex: Integer);
|
|
var
|
|
TempEnabled: Boolean;
|
|
TempState: TCheckBoxState;
|
|
begin
|
|
with TJvxCheckListBox(ListBox) do
|
|
begin
|
|
TempState := State[CurIndex];
|
|
TempEnabled := EnabledItem[CurIndex];
|
|
inherited Move(CurIndex, NewIndex);
|
|
State[NewIndex] := TempState;
|
|
EnabledItem[NewIndex] := TempEnabled;
|
|
end;
|
|
end;
|
|
|
|
//=== { TJvxCheckListBox } ===================================================
|
|
|
|
// (rom) changed to var
|
|
var
|
|
GCheckBitmap: TBitmap = nil;
|
|
|
|
function CheckBitmap: TBitmap;
|
|
begin
|
|
if GCheckBitmap = nil then
|
|
begin
|
|
GCheckBitmap := TBitmap.Create;
|
|
GCheckBitmap.Handle := LoadBitmap(HInstance, 'JvxCheckListBoxIMAGES');
|
|
end;
|
|
Result := GCheckBitmap;
|
|
end;
|
|
|
|
const
|
|
InternalVersion = 202; { for backward compatibility only }
|
|
|
|
constructor TJvxCheckListBox.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAutoScroll := True;
|
|
with CheckBitmap do
|
|
begin
|
|
FCheckWidth := Width div 6;
|
|
FCheckHeight := Height div 3;
|
|
end;
|
|
FDrawBitmap := TBitmap.Create;
|
|
with FDrawBitmap do
|
|
begin
|
|
Width := FCheckWidth;
|
|
Height := FCheckHeight;
|
|
end;
|
|
FIniLink := TJvIniLink.Create;
|
|
FIniLink.OnSave := IniSave;
|
|
FIniLink.OnLoad := IniLoad;
|
|
end;
|
|
|
|
destructor TJvxCheckListBox.Destroy;
|
|
begin
|
|
FSaveStates.Free;
|
|
FSaveStates := nil;
|
|
FDrawBitmap.Free;
|
|
FDrawBitmap := nil;
|
|
FIniLink.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.Loaded;
|
|
begin
|
|
inherited Loaded;
|
|
UpdateCheckStates;
|
|
end;
|
|
|
|
function TJvxCheckListBox.CreateItemList: TStrings;
|
|
begin
|
|
Result := TJvCheckListBoxStrings.Create;
|
|
end;
|
|
|
|
const
|
|
sCount = 'Count';
|
|
sItem = 'Item';
|
|
|
|
procedure TJvxCheckListBox.LoadFromAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
|
|
var
|
|
I: Integer;
|
|
ACount: Integer;
|
|
begin
|
|
ACount := Min(AppStorage.ReadInteger(AppStorage.ConcatPaths([Path, sCount]), 0), Items.Count);
|
|
for I := 0 to ACount - 1 do
|
|
begin
|
|
State[I] := TCheckBoxState(AppStorage.ReadInteger(AppStorage.ConcatPaths([Path, sItem + IntToStr(I)]),
|
|
Integer(clbDefaultState)));
|
|
if (State[I] = cbChecked) and (FCheckKind = ckRadioButtons) then
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SaveToAppStorage(const AppStorage: TJvCustomAppStorage; const Path: string);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
AppStorage.DeleteSubTree(Path);
|
|
AppStorage.WriteInteger(AppStorage.ConcatPaths([Path, sCount]), Items.Count);
|
|
for I := 0 to Items.Count - 1 do
|
|
AppStorage.WriteInteger(AppStorage.ConcatPaths([Path, sItem + IntToStr(I)]), Ord(State[I]));
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.Load;
|
|
begin
|
|
IniLoad(nil);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.Save;
|
|
begin
|
|
IniSave(nil);
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetStorage: TJvFormPlacement;
|
|
begin
|
|
Result := FIniLink.Storage;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetStorage(Value: TJvFormPlacement);
|
|
begin
|
|
FIniLink.Storage := Value;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.IniSave(Sender: TObject);
|
|
begin
|
|
if (Name <> '') and Assigned(IniStorage) then
|
|
InternalSave(GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.IniLoad(Sender: TObject);
|
|
begin
|
|
if (Name <> '') and Assigned(IniStorage) then
|
|
InternalLoad(GetDefaultSection(Self));
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ReadCheckData(Reader: TReader);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
try
|
|
Reader.ReadListBegin;
|
|
Clear;
|
|
while not Reader.EndOfList do
|
|
begin
|
|
I := Items.Add(Reader.ReadString);
|
|
if FReserved >= InternalVersion then
|
|
begin
|
|
State[I] := TCheckBoxState(Reader.ReadInteger);
|
|
EnabledItem[I] := Reader.ReadBoolean;
|
|
end
|
|
else
|
|
begin { for backward compatibility only }
|
|
Checked[I] := Reader.ReadBoolean;
|
|
EnabledItem[I] := Reader.ReadBoolean;
|
|
if FReserved > 0 then
|
|
State[I] := TCheckBoxState(Reader.ReadInteger);
|
|
end;
|
|
end;
|
|
Reader.ReadListEnd;
|
|
UpdateCheckStates;
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.WriteCheckData(Writer: TWriter);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
with Writer do
|
|
begin
|
|
WriteListBegin;
|
|
for I := 0 to Items.Count - 1 do
|
|
begin
|
|
WriteString(Items[I]);
|
|
WriteInteger(Ord(Self.State[I]));
|
|
WriteBoolean(EnabledItem[I]);
|
|
end;
|
|
WriteListEnd;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ReadVersion(Reader: TReader);
|
|
begin
|
|
FReserved := Reader.ReadInteger;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.WriteVersion(Writer: TWriter);
|
|
begin
|
|
Writer.WriteInteger(InternalVersion);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.DefineProperties(Filer: TFiler);
|
|
|
|
function DoWrite: Boolean;
|
|
var
|
|
I: Integer;
|
|
Ancestor: TJvxCheckListBox;
|
|
begin
|
|
Result := False;
|
|
Ancestor := TJvxCheckListBox(Filer.Ancestor);
|
|
if (Ancestor <> nil) and (Ancestor.Items.Count = Items.Count) and
|
|
(Ancestor.Items.Count > 0) then
|
|
for I := 1 to Items.Count - 1 do
|
|
begin
|
|
Result := (CompareText(Items[I], Ancestor.Items[I]) <> 0) or
|
|
(State[I] <> Ancestor.State[I]) or
|
|
(EnabledItem[I] <> Ancestor.EnabledItem[I]);
|
|
if Result then
|
|
Break;
|
|
end
|
|
else
|
|
Result := Items.Count > 0;
|
|
end;
|
|
|
|
begin
|
|
inherited DefineProperties(Filer);
|
|
Filer.DefineProperty('InternalVersion', ReadVersion, WriteVersion, Filer.Ancestor = nil);
|
|
Filer.DefineProperty('Strings', ReadCheckData, WriteCheckData, DoWrite);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.CreateWnd;
|
|
begin
|
|
inherited CreateWnd;
|
|
if FSaveStates <> nil then
|
|
begin
|
|
FSaveStates.Free;
|
|
FSaveStates := nil;
|
|
end;
|
|
ResetItemHeight;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.DestroyWnd;
|
|
begin
|
|
inherited DestroyWnd;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.WMDestroy(var Msg: TWMDestroy);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Items.Count > 0 then
|
|
begin
|
|
if FSaveStates <> nil then
|
|
FSaveStates.Clear
|
|
else
|
|
FSaveStates := TList.Create;
|
|
for I := 0 to Items.Count - 1 do
|
|
begin
|
|
FSaveStates.Add(TObject(MakeLong(Ord(EnabledItem[I]), Word(State[I]))));
|
|
FindCheckObject(I).Free;
|
|
end;
|
|
end;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.CreateParams(var Params: TCreateParams);
|
|
begin
|
|
inherited CreateParams(Params);
|
|
with Params do
|
|
if Style and (LBS_OWNERDRAWFIXED or LBS_OWNERDRAWVARIABLE) = 0 then
|
|
Style := Style or LBS_OWNERDRAWFIXED;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetItems(Value: TStrings);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Items.BeginUpdate;
|
|
try
|
|
inherited SetItems(Value);
|
|
if (Value <> nil) and (Value is TJvListBoxStrings) and
|
|
(TJvListBoxStrings(Value).ListBox <> nil) and
|
|
(TJvListBoxStrings(Value).ListBox is TJvxCheckListBox) then
|
|
begin
|
|
for I := 0 to Items.Count - 1 do
|
|
if I < Value.Count then
|
|
begin
|
|
Self.State[I] := TJvxCheckListBox(TJvListBoxStrings(Value).ListBox).State[I];
|
|
EnabledItem[I] :=
|
|
TJvxCheckListBox(TJvListBoxStrings(Value).ListBox).EnabledItem[I];
|
|
end;
|
|
end;
|
|
finally
|
|
Items.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.InternalLoad(const Section: string);
|
|
begin
|
|
if Assigned(IniStorage) then
|
|
with IniStorage do
|
|
LoadFromAppStorage(AppStorage, AppStorage.ConcatPaths([AppStoragePath, Section]));
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.InternalSave(const Section: string);
|
|
begin
|
|
if Assigned(IniStorage) then
|
|
with IniStorage do
|
|
SaveToAppStorage(AppStorage, AppStorage.ConcatPaths([AppStoragePath, Section]));
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetItemWidth(Index: Integer): Integer;
|
|
begin
|
|
Result := inherited GetItemWidth(Index) + GetCheckWidth;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetCheckWidth: Integer;
|
|
begin
|
|
Result := FCheckWidth + 2;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetAllowGrayed: Boolean;
|
|
begin
|
|
Result := FAllowGrayed and (FCheckKind in [ckCheckBoxes, ckCheckMarks]);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.FontChanged;
|
|
begin
|
|
inherited FontChanged;
|
|
ResetItemHeight;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetItemHeight: Integer;
|
|
var
|
|
R: TRect;
|
|
begin
|
|
Result := FItemHeight;
|
|
if HandleAllocated and ((FStyle = lbStandard) or
|
|
((FStyle = lbOwnerDrawFixed) and not Assigned(FOnDrawItem))) then
|
|
begin
|
|
Perform(LB_GETITEMRECT, 0, LPARAM(@R));
|
|
Result := R.Bottom - R.Top;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ResetItemHeight;
|
|
var
|
|
H: Integer;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if (Style = lbStandard) or ((Style = lbOwnerDrawFixed) and
|
|
not Assigned(FOnDrawItem)) then
|
|
begin
|
|
FCanvas.Font := Font;
|
|
H := Max(CanvasMaxTextHeight(FCanvas), FCheckHeight);
|
|
if Style = lbOwnerDrawFixed then
|
|
H := Max(H, FItemHeight);
|
|
Perform(LB_SETITEMHEIGHT, 0, H);
|
|
if (H * Items.Count) <= ClientHeight then
|
|
SetScrollRange(Handle, SB_VERT, 0, 0, True);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.DrawItem(Index: Integer; Rect: TRect;
|
|
State: TOwnerDrawState);
|
|
var
|
|
R: TRect;
|
|
SaveEvent: TDrawItemEvent;
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
if Index < Items.Count then
|
|
begin
|
|
R := Rect;
|
|
if not UseRightToLeftAlignment then
|
|
begin
|
|
R.Right := Rect.Left;
|
|
R.Left := R.Right - GetCheckWidth;
|
|
end
|
|
else
|
|
begin
|
|
R.Left := Rect.Right;
|
|
R.Right := R.Left + GetCheckWidth;
|
|
end;
|
|
DrawCheck(R, GetState(Index), EnabledItem[Index]);
|
|
if not EnabledItem[Index] then
|
|
if odSelected in State then
|
|
FCanvas.Font.Color := clInactiveCaptionText
|
|
else
|
|
FCanvas.Font.Color := clGrayText;
|
|
end;
|
|
if (Style = lbStandard) and Assigned(FOnDrawItem) then
|
|
begin
|
|
SaveEvent := OnDrawItem;
|
|
OnDrawItem := nil;
|
|
try
|
|
inherited DrawItem(Index, Rect, State);
|
|
finally
|
|
OnDrawItem := SaveEvent;
|
|
end;
|
|
end
|
|
else
|
|
inherited DrawItem(Index, Rect, State);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.CNDrawItem(var Msg: TWMDrawItem);
|
|
begin
|
|
with Msg.DrawItemStruct^ do
|
|
if not UseRightToLeftAlignment then
|
|
rcItem.Left := rcItem.Left + GetCheckWidth
|
|
else
|
|
rcItem.Right := rcItem.Right - GetCheckWidth;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.DrawCheck(R: TRect; AState: TCheckBoxState;
|
|
Enabled: Boolean);
|
|
const
|
|
CheckImages: array [TCheckBoxState, TCheckKind, Boolean] of Integer =
|
|
(((3, 0), (9, 6), (15, 12)), { unchecked }
|
|
((4, 1), (10, 7), (16, 13)), { checked }
|
|
((5, 2), (11, 8), (17, 14))); { grayed }
|
|
var
|
|
DrawRect: TRect;
|
|
SaveColor: TColor;
|
|
{$IFDEF JVCLThemesEnabled}
|
|
Flags: Cardinal;
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
if csDestroying in ComponentState then
|
|
Exit;
|
|
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;
|
|
SaveColor := FCanvas.Brush.Color;
|
|
{$IFDEF JVCLThemesEnabled}
|
|
if ThemeServices.ThemesEnabled and (CheckKind in [ckCheckBoxes, ckRadioButtons]) then
|
|
begin
|
|
Flags := 0;
|
|
if not Enabled then
|
|
Flags := Flags or DFCS_INACTIVE;
|
|
if AState = cbChecked then
|
|
Flags := Flags or DFCS_CHECKED
|
|
else
|
|
if AState = cbGrayed then
|
|
Flags := Flags or DFCS_MONO;
|
|
if CheckKind = ckCheckBoxes then
|
|
DrawThemedFrameControl(Canvas.Handle, DrawRect, DFC_BUTTON,
|
|
DFCS_BUTTONCHECK or Flags)
|
|
else
|
|
if CheckKind = ckRadioButtons then
|
|
DrawThemedFrameControl(Canvas.Handle, DrawRect, DFC_BUTTON,
|
|
DFCS_BUTTONRADIO or Flags);
|
|
end
|
|
else
|
|
{$ENDIF JVCLThemesEnabled}
|
|
begin
|
|
AssignBitmapCell(CheckBitmap, FDrawBitmap, 6, 3,
|
|
CheckImages[AState, CheckKind, Enabled]);
|
|
FCanvas.Brush.Color := Self.Color;
|
|
try
|
|
FCanvas.BrushCopy(DrawRect, FDrawBitmap, Bounds(0, 0, FCheckWidth,
|
|
FCheckHeight), CheckBitmap.TransparentColor and not PaletteMask);
|
|
finally
|
|
FCanvas.Brush.Color := SaveColor;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ApplyState(AState: TCheckBoxState; EnabledOnly: Boolean);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if FCheckKind in [ckCheckBoxes, ckCheckMarks] then
|
|
for I := 0 to Items.Count - 1 do
|
|
if not EnabledOnly or EnabledItem[I] then
|
|
State[I] := AState;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetCheckedIndex: Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Result := -1;
|
|
if FCheckKind = ckRadioButtons then
|
|
for I := 0 to Items.Count - 1 do
|
|
if State[I] = cbChecked then
|
|
begin
|
|
Result := I;
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetCheckedIndex(Value: Integer);
|
|
begin
|
|
if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then
|
|
SetState(Max(Value, 0), cbChecked);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.UpdateCheckStates;
|
|
begin
|
|
if (FCheckKind = ckRadioButtons) and (Items.Count > 0) then
|
|
begin
|
|
FInUpdateStates := True;
|
|
try
|
|
SetState(Max(GetCheckedIndex, 0), cbChecked);
|
|
finally
|
|
FInUpdateStates := False;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetCheckKind(Value: TCheckKind);
|
|
begin
|
|
if FCheckKind <> Value then
|
|
begin
|
|
FCheckKind := Value;
|
|
UpdateCheckStates;
|
|
Invalidate;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetChecked(Index: Integer; AChecked: Boolean);
|
|
const
|
|
CheckStates: array [Boolean] of TCheckBoxState = (cbUnchecked, cbChecked);
|
|
begin
|
|
SetState(Index, CheckStates[AChecked]);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetState(Index: Integer; AState: TCheckBoxState);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if (AState <> GetState(Index)) or FInUpdateStates then
|
|
begin
|
|
if (FCheckKind = ckRadioButtons) and (AState = cbUnchecked) and
|
|
(GetCheckedIndex = Index) then
|
|
Exit;
|
|
TJvCheckListBoxItem(GetCheckObject(Index)).State := AState;
|
|
if (FCheckKind = ckRadioButtons) and (AState = cbChecked) then
|
|
for I := Items.Count - 1 downto 0 do
|
|
begin
|
|
if (I <> Index) and (GetState(I) = cbChecked) then
|
|
begin
|
|
TJvCheckListBoxItem(GetCheckObject(I)).State := cbUnchecked;
|
|
InvalidateCheck(I);
|
|
end;
|
|
end;
|
|
InvalidateCheck(Index);
|
|
if not (csReading in ComponentState) then
|
|
ChangeItemState(Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetItemEnabled(Index: Integer; Value: Boolean);
|
|
begin
|
|
if Value <> GetItemEnabled(Index) then
|
|
begin
|
|
TJvCheckListBoxItem(GetCheckObject(Index)).Enabled := Value;
|
|
InvalidateItem(Index);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.InvalidateCheck(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
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;
|
|
|
|
procedure TJvxCheckListBox.InvalidateItem(Index: Integer);
|
|
var
|
|
R: TRect;
|
|
begin
|
|
R := ItemRect(Index);
|
|
InvalidateRect(Handle, @R, not (csOpaque in ControlStyle));
|
|
UpdateWindow(Handle);
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetChecked(Index: Integer): Boolean;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TJvCheckListBoxItem(GetCheckObject(Index)).GetChecked
|
|
else
|
|
Result := False;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetState(Index: Integer): TCheckBoxState;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TJvCheckListBoxItem(GetCheckObject(Index)).State
|
|
else
|
|
Result := clbDefaultState;
|
|
if (FCheckKind = ckRadioButtons) and (Result <> cbChecked) then
|
|
Result := cbUnchecked;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetItemEnabled(Index: Integer): Boolean;
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
Result := TJvCheckListBoxItem(GetCheckObject(Index)).Enabled
|
|
else
|
|
Result := clbDefaultEnabled;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.KeyPress(var Key: Char);
|
|
begin
|
|
inherited KeyPress(Key);
|
|
case Key of
|
|
' ':
|
|
begin
|
|
ToggleClickCheck(ItemIndex);
|
|
Key := #0;
|
|
end;
|
|
'+':
|
|
begin
|
|
ApplyState(cbChecked, True);
|
|
ClickCheck;
|
|
end;
|
|
'-':
|
|
begin
|
|
ApplyState(cbUnchecked, True);
|
|
ClickCheck;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.MouseDown(Button: TMouseButton; Shift: TShiftState;
|
|
X, Y: Integer);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
inherited MouseDown(Button, Shift, X, Y);
|
|
if Button = mbLeft then
|
|
begin
|
|
Index := ItemAtPos(Point(X, Y), True);
|
|
if Index <> -1 then
|
|
begin
|
|
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;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ToggleClickCheck(Index: Integer);
|
|
var
|
|
State: TCheckBoxState;
|
|
begin
|
|
if (Index >= 0) and (Index < Items.Count) and EnabledItem[Index] then
|
|
begin
|
|
State := Self.State[Index];
|
|
case State of
|
|
cbUnchecked:
|
|
if AllowGrayed then
|
|
State := cbGrayed
|
|
else
|
|
State := cbChecked;
|
|
cbChecked:
|
|
State := cbUnchecked;
|
|
cbGrayed:
|
|
State := cbChecked;
|
|
end;
|
|
Self.State[Index] := State;
|
|
ClickCheck;
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ChangeItemState(Index: Integer);
|
|
begin
|
|
if Assigned(FOnStateChange) then
|
|
FOnStateChange(Self, Index);
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ClickCheck;
|
|
begin
|
|
if Assigned(FOnClickCheck) then
|
|
FOnClickCheck(Self);
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetItemData(Index: Integer): Longint;
|
|
var
|
|
Item: TJvCheckListBoxItem;
|
|
begin
|
|
Result := 0;
|
|
if IsCheckObject(Index) then
|
|
begin
|
|
Item := TJvCheckListBoxItem(GetCheckObject(Index));
|
|
if Item <> nil then
|
|
Result := Item.FData;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCheckListBox.GetCheckObject(Index: Integer): TObject;
|
|
begin
|
|
Result := FindCheckObject(Index);
|
|
if Result = nil then
|
|
Result := CreateCheckObject(Index);
|
|
end;
|
|
|
|
function TJvxCheckListBox.FindCheckObject(Index: Integer): TObject;
|
|
var
|
|
ItemData: Longint;
|
|
begin
|
|
Result := nil;
|
|
ItemData := inherited GetItemData(Index);
|
|
if ItemData = LB_ERR then
|
|
ListIndexError(Index)
|
|
else
|
|
begin
|
|
Result := TJvCheckListBoxItem(TObject(ItemData));
|
|
if not (Result is TJvCheckListBoxItem) then
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TJvxCheckListBox.CreateCheckObject(Index: Integer): TObject;
|
|
begin
|
|
Result := TJvCheckListBoxItem.Create;
|
|
inherited SetItemData(Index, Longint(Result));
|
|
end;
|
|
|
|
function TJvxCheckListBox.IsCheckObject(Index: Integer): Boolean;
|
|
begin
|
|
Result := FindCheckObject(Index) <> nil;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.SetItemData(Index: Integer; AData: Longint);
|
|
var
|
|
Item: TJvCheckListBoxItem;
|
|
L: Longint;
|
|
begin
|
|
Item := TJvCheckListBoxItem(GetCheckObject(Index));
|
|
Item.FData := AData;
|
|
if (FSaveStates <> nil) and (FSaveStates.Count > 0) then
|
|
begin
|
|
L := Longint(FSaveStates[0]);
|
|
Item.FState := TCheckBoxState(HiWord(L));
|
|
Item.FEnabled := LoWord(L) <> 0;
|
|
FSaveStates.Delete(0);
|
|
end;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.ResetContent;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := Items.Count - 1 downto 0 do
|
|
begin
|
|
if IsCheckObject(I) then
|
|
GetCheckObject(I).Free;
|
|
inherited SetItemData(I, 0);
|
|
end;
|
|
inherited ResetContent;
|
|
end;
|
|
|
|
procedure TJvxCheckListBox.DeleteString(Index: Integer);
|
|
begin
|
|
if IsCheckObject(Index) then
|
|
GetCheckObject(Index).Free;
|
|
inherited SetItemData(Index, 0);
|
|
inherited DeleteString(Index);
|
|
end;
|
|
|
|
initialization
|
|
{$IFDEF UNITVERSIONING}
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
finalization
|
|
FreeAndNil(GCheckBitmap);
|
|
{$IFDEF UNITVERSIONING}
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|