paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-22 02:09:38 +01:00
Code Issues Packages Projects Releases Wiki Activity

win32: TCheckListBox:

Browse Source 
- move TCheckListBox code from the general WindowProc to the private one
  - preserve data on ListBox item change and appropriate code for TCheckListBox

git-svn-id: trunk@22039 -
This commit is contained in:
paul 2009-10-05 07:57:09 +00:00
parent a35abe991c
commit c6ba3e76d8
5 changed files with 146 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
lcl/interfaces/win32/win32callback.inc
View File

@ -574,38 +574,6 @@ var
MoveWindowOrgEx(ControlDC, P.X, P.Y);
end;
procedure CheckListBoxLButtonDown;
var
I: Integer;
ItemRect: Windows.Rect;
MousePos: Windows.Point;
Message: TLMessage;
begin
MousePos.X := LMMouse.Pos.X;
MousePos.Y := LMMouse.Pos.Y;
for I := 0 to Windows.SendMessage(Window, LB_GETCOUNT, 0, 0) - 1 do
begin
Windows.SendMessage(Window, LB_GETITEMRECT, I, PtrInt(@ItemRect));
ItemRect.Right := ItemRect.Left + ItemRect.Bottom - ItemRect.Top;
if Windows.PtInRect(ItemRect, MousePos) then
begin
// item clicked: toggle
if I < TCheckListBox(lWinControl).Items.Count then
begin
if TCheckListBox(lWinControl).ItemEnabled[I] then
begin
TCheckListBox(lWinControl).Toggle(I);
Message.Msg := LM_CHANGED;
Message.WParam := I;
DeliverMessage(lWinControl, Message);
end;
end;
// can only click one item
exit;
end;
end;
end;
procedure ClearSiblingRadioButtons(RadioButton: TRadioButton);
var
Parent: TWinControl;
@ -1844,10 +1812,6 @@ begin
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
end;
// CheckListBox functionality
if lWinControl is TCheckListBox then
CheckListBoxLButtonDown;
end;
WM_LBUTTONDOWN:
begin
@ -1887,10 +1851,6 @@ begin
YPos := GET_Y_LPARAM(LParam);
Keys := WParam;
end;
// CheckListBox functionality
if lWinControl is TCheckListBox then
CheckListBoxLButtonDown;
end;
WM_LBUTTONUP:
begin

64
lcl/interfaces/win32/win32listsl.inc
View File

@ -86,6 +86,16 @@ begin
end;
end;
function TWin32ListStringList.SaveData(AIndex: Integer): Pointer;
begin
Result := GetObject(AIndex);
end;
procedure TWin32ListStringList.RestoreData(AIndex: Integer; AData: Pointer);
begin
PutObject(AIndex, TObject(AData));
end;
{------------------------------------------------------------------------------
Method: TWin32ListStringList.Sort
Params:
@ -263,8 +273,9 @@ end;
procedure TWin32ListStringList.Put(Index: integer; const S: string);
var
lItemIndex: integer;
lSelected: boolean;
lItemIndex: Integer;
lSelected: Boolean;
AData: Pointer;
begin
// remember selection
lItemIndex := -1;
@ -280,16 +291,19 @@ begin
lItemIndex := SendMessage(FWin32List, FFlagGetItemIndex, 0, 0);
lSelected := lItemIndex >= 0;
end;
// preserve data
AData := SaveData(Index);
inherited;
if AData <> nil then
RestoreData(Index, AData);
if lSelected then
begin
if (FFlagSetSelected = 0)
or (SendMessage(FWin32List, FFlagSetSelected, Windows.WParam(true), lItemIndex) = -1) then
begin
if (FFlagSetSelected = 0) or (SendMessage(FWin32List, FFlagSetSelected, Windows.WParam(true), lItemIndex) = -1) then
SendMessage(FWin32List, FFlagSetItemIndex, lItemIndex, 0);
end;
end;
end;
@ -435,7 +449,7 @@ end;
{ TWin32CheckListBoxStrings }
constructor TWin32CheckListBoxStrings.Create(List : HWND; TheOwner: TWinControl);
constructor TWin32CheckListBoxStrings.Create(List: HWND; TheOwner: TWinControl);
begin
inherited Create(List, TheOwner);
with FDefaultItem do
@ -529,23 +543,51 @@ begin
SetItemRecord(Index, ItemRecord);
end;
function TWin32CheckListBoxStrings.SaveData(AIndex: Integer): Pointer;
var
ItemRecord: PWin32CheckListBoxItemRecord;
begin
ItemRecord := GetItemRecord(AIndex, False);
if ItemRecord = nil then
Result := nil
else
begin
Result := new(PWin32CheckListBoxItemRecord);
PWin32CheckListBoxItemRecord(Result)^ := ItemRecord^;
end;
end;
procedure TWin32CheckListBoxStrings.RestoreData(AIndex: Integer; AData: Pointer);
var
ItemRecord: PWin32CheckListBoxItemRecord absolute AData;
OldRecord: PWin32CheckListBoxItemRecord;
begin
if ItemRecord <> nil then
begin
OldRecord := GetItemRecord(AIndex, True);
OldRecord^ := ItemRecord^;
SetItemRecord(AIndex, OldRecord);
Dispose(ItemRecord);
end;
end;
class procedure TWin32CheckListBoxStrings.DeleteItemRecords(const List: HWND);
var
Index: Integer;
ItemCount: Integer;
begin
ItemCount := Windows.SendMessage(List, LB_GETCOUNT, 0, 0);
for Index := 0 to ItemCount-1 do
for Index := 0 to ItemCount - 1 do
DeleteItemRecord(List, Index);
end;
class procedure TWin32CheckListBoxStrings.DeleteItemRecord(const List: HWND;const Index: integer);
class procedure TWin32CheckListBoxStrings.DeleteItemRecord(const List: HWND; const Index: integer);
var
ItemRecord: PWin32CheckListBoxItemRecord;
begin
ItemRecord := PWin32CheckListBoxItemRecord(Windows.SendMessage(List, LB_GETITEMDATA, Index, 0));
if Assigned(ItemRecord)
then Dispose(ItemRecord);
if Assigned(ItemRecord) then
Dispose(ItemRecord);
end;
{$IFDEF H_PLUS}

6
lcl/interfaces/win32/win32listslh.inc
View File

@ -64,6 +64,8 @@ Type
procedure InitFlags; virtual;
procedure SetSorted(Val: Boolean); Virtual;
function SaveData(AIndex: Integer): Pointer; virtual;
procedure RestoreData(AIndex: Integer; AData: Pointer); virtual;
public
constructor Create(List : HWND; TheOwner: TWinControl);
function Add(const S: string): Integer; override;
@ -118,8 +120,10 @@ Type
protected
function GetObject(Index: Integer): TObject; override;
procedure PutObject(Index: Integer; AObject: TObject); override;
function SaveData(AIndex: Integer): Pointer; override;
procedure RestoreData(AIndex: Integer; AData: Pointer); override;
public
constructor Create(List : HWND; TheOwner: TWinControl);
constructor Create(List: HWND; TheOwner: TWinControl);
class procedure DeleteItemRecords(const List: HWND);
class procedure DeleteItemRecord(const List: HWND; const Index: integer);
procedure Clear; override;

73
lcl/interfaces/win32/win32wschecklst.pp
View File

@ -33,9 +33,9 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Classes, CheckLst, StdCtrls,
Windows, Classes, Controls, CheckLst, StdCtrls, LCLType, LMessages, LCLMessageGlue,
////////////////////////////////////////////////////
WSCheckLst, WSLCLClasses, Win32Int, Win32Proc, Windows;
WSCheckLst, WSLCLClasses, Win32Int, Win32Proc, Win32WSControls, Win32WSStdCtrls;
type
@ -43,8 +43,9 @@ type
TWin32WSCustomCheckListBox = class(TWSCustomCheckListBox)
published
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class function GetItemEnabled(const ACheckListBox: TCustomCheckListBox;
const AIndex: integer): Boolean; override;
class function GetState(const ACheckListBox: TCustomCheckListBox;
@ -58,6 +59,70 @@ type
implementation
function CheckListBoxWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
var
WindowInfo: PWin32WindowInfo;
procedure CheckListBoxLButtonDown;
var
I: Integer;
ItemRect: Windows.Rect;
MousePos: Windows.Point;
Message: TLMessage;
begin
MousePos.X := GET_X_LPARAM(LParam);
MousePos.Y := GET_Y_LPARAM(LParam);
for I := 0 to Windows.SendMessage(Window, LB_GETCOUNT, 0, 0) - 1 do
begin
Windows.SendMessage(Window, LB_GETITEMRECT, I, PtrInt(@ItemRect));
ItemRect.Right := ItemRect.Left + ItemRect.Bottom - ItemRect.Top;
if Windows.PtInRect(ItemRect, MousePos) then
begin
// item clicked: toggle
if I < TCheckListBox(WindowInfo^.WinControl).Items.Count then
begin
if TCheckListBox(WindowInfo^.WinControl).ItemEnabled[I] then
begin
TCheckListBox(WindowInfo^.WinControl).Toggle(I);
Message.Msg := LM_CHANGED;
Message.WParam := I;
DeliverMessage(WindowInfo^.WinControl, Message);
end;
end;
// can only click one item
Exit;
end;
end;
end;
begin
Result := WindowProc(Window, Msg, WParam, LParam);
// move groupbox specific code here
case Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
WindowInfo := GetWin32WindowInfo(Window);
if (WindowInfo <> nil) and (WindowInfo^.WinControl <> nil) then
CheckListBoxLButtonDown;
end;
end;
end;
class function TWin32WSCustomCheckListBox.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle;
var
Params: TCreateWindowExParams;
begin
Params := GetListBoxParams(TCustomListBox(AWinControl), AParams, True);
Params.SubClassWndProc := @CheckListBoxWndProc;
// create window
FinishCreateWindow(AWinControl, Params, False);
// listbox is not a transparent control -> no need for parentpainting
Params.WindowInfo^.needParentPaint := False;
Result := Params.Window;
end;
class function TWin32WSCustomCheckListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
var
Handle: HWND;

29
lcl/interfaces/win32/win32wsstdctrls.pp
View File

@ -288,6 +288,9 @@ function EditGetSelLength(WinHandle: HWND): integer;
procedure EditSetSelStart(WinHandle: HWND; NewStart: integer);
procedure EditSetSelLength(WinHandle: HWND; NewLength: integer);
function GetListBoxParams(AListBox: TCustomListBox;
const AParams: TCreateParams; IsCheckList: Boolean): TCreateWindowExParams;
{$DEFINE MEMOHEADER}
{$I win32memostrings.inc}
{$UNDEF MEMOHEADER}
@ -554,17 +557,15 @@ begin
end;
end;
class function TWin32WSCustomListBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Params: TCreateWindowExParams;
function GetListBoxParams(AListBox: TCustomListBox;
const AParams: TCreateParams; IsCheckList: Boolean): TCreateWindowExParams;
begin
// general initialization of Params
PrepareCreateWindow(AWinControl, Params);
PrepareCreateWindow(AListBox, Result);
// customization of Params
with Params do
with Result do
begin
with TCustomListBox(AWinControl) do
with AListBox do
begin
if Sorted then
Flags := Flags or LBS_SORT;
@ -576,7 +577,7 @@ begin
if Columns > 1 then
Flags := Flags or LBS_MULTICOLUMN;
if (AWinControl.FCompStyle = csCheckListBox) and (Style = lbStandard) then
if IsCheckList and (Style = lbStandard) then
Flags := Flags or LBS_OWNERDRAWFIXED
else
case Style of
@ -591,10 +592,18 @@ begin
Flags := Flags or (WS_HSCROLL or WS_VSCROLL or LBS_NOINTEGRALHEIGHT or LBS_HASSTRINGS or
LBS_NOTIFY);
end;
end;
class function TWin32WSCustomListBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Params: TCreateWindowExParams;
begin
Params := GetListBoxParams(TCustomListBox(AWinControl), AParams, False);
// create window
FinishCreateWindow(AWinControl, Params, false);
FinishCreateWindow(AWinControl, Params, False);
// listbox is not a transparent control -> no need for parentpainting
Params.WindowInfo^.needParentPaint := false;
Params.WindowInfo^.needParentPaint := False;
Result := Params.Window;
end;