paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-07 12:16:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

lcl, win32: move ListBox, CheckListBox styles into CreateParams of LCL classes

Browse Source 
git-svn-id: trunk@29914 -
This commit is contained in:
paul 2011-03-19 16:40:11 +00:00
parent c011106ea9
commit dfc3dc15df
7 changed files with 58 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/checklst.pas
View File

@ -57,6 +57,7 @@ type
class procedure WSRegisterClass; override;
procedure AssignItemDataToCache(const AIndex: Integer; const AData: Pointer); override;
procedure AssignCacheToItemData(const AIndex: Integer; const AData: Pointer); override;
procedure CreateParams(var Params: TCreateParams); override;
function GetCachedDataSize: Integer; override;
procedure DefineProperties(Filer: TFiler); override;
procedure ReadData(Stream: TStream);
@ -172,6 +173,12 @@ begin
SendItemEnabled(AIndex, not PCachedItemData(AData + FItemDataOffset)^.Disabled);
end;
procedure TCustomCheckListBox.CreateParams(var Params: TCreateParams);
begin
inherited CreateParams(Params);
Params.Style := (Params.Style and not LBS_OWNERDRAWVARIABLE) or LBS_OWNERDRAWFIXED;
end;
procedure TCustomCheckListBox.AssignItemDataToCache(const AIndex: Integer;
const AData: Pointer);
begin

20
lcl/include/customlistbox.inc
View File

@ -72,6 +72,26 @@ begin
end;
end;
procedure TCustomListBox.CreateParams(var Params: TCreateParams);
const
MultiSelectStyle: array[Boolean] of DWord = (LBS_MULTIPLESEL, LBS_EXTENDEDSEL);
begin
inherited CreateParams(Params);
if Sorted then
Params.Style := Params.Style or LBS_SORT;
if MultiSelect then
Params.Style := Params.Style or MultiSelectStyle[ExtendedSelect];
if Columns > 1 then
Params.Style := Params.Style or LBS_MULTICOLUMN;
case Style of
lbOwnerDrawFixed: Params.Style := Params.Style or LBS_OWNERDRAWFIXED;
lbOwnerDrawVariable: Params.Style := Params.Style or LBS_OWNERDRAWVARIABLE;
end;
Params.Style := Params.Style or
(WS_HSCROLL or WS_VSCROLL or LBS_NOINTEGRALHEIGHT or LBS_HASSTRINGS or LBS_NOTIFY);
end;
{------------------------------------------------------------------------------
procedure TCustomListBox.AssignItemDataToCache
------------------------------------------------------------------------------}

1
lcl/interfaces/win32/win32int.pp
View File

@ -216,6 +216,7 @@ const
EditClsName: array[0..4] of char = 'Edit'#0;
ButtonClsName: array[0..6] of char = 'Button'#0;
ComboboxClsName: array[0..8] of char = 'ComboBox'#0;
ListboxClsName: array[0..8] of char = 'LISTBOX'#0;
TabControlClsName: array[0..15] of char = 'SysTabControl32'#0;
ListViewClsName: array[0..13] of char = 'SysListView32'#0;

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

@ -156,8 +156,13 @@ class function TWin32WSCustomCheckListBox.CreateHandle(
var
Params: TCreateWindowExParams;
begin
Params := GetListBoxParams(TCustomListBox(AWinControl), AParams, True);
Params.SubClassWndProc := @CheckListBoxWndProc;
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
with Params do
begin
pClassName := ListBoxClsName;
SubClassWndProc := @CheckListBoxWndProc;
end;
// create window
FinishCreateWindow(AWinControl, Params, False);
// listbox is not a transparent control -> no need for parentpainting

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

@ -296,9 +296,6 @@ 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}
@ -581,46 +578,15 @@ begin
end;
end;
function GetListBoxParams(AListBox: TCustomListBox;
const AParams: TCreateParams; IsCheckList: Boolean): TCreateWindowExParams;
begin
// general initialization of Params
PrepareCreateWindow(AListBox, AParams, Result);
// customization of Params
with Result do
begin
with AListBox do
begin
if Sorted then
Flags := Flags or LBS_SORT;
if MultiSelect then
if ExtendedSelect then
Flags := Flags or LBS_EXTENDEDSEL
else
Flags := Flags or LBS_MULTIPLESEL;
if Columns > 1 then
Flags := Flags or LBS_MULTICOLUMN;
if IsCheckList and (Style = lbStandard) then
Flags := Flags or LBS_OWNERDRAWFIXED
else
case Style of
lbOwnerDrawFixed: Flags := Flags or LBS_OWNERDRAWFIXED;
lbOwnerDrawVariable: Flags := Flags or LBS_OWNERDRAWVARIABLE;
end;
end;
pClassName := 'LISTBOX';
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);
// general initialization of Params
PrepareCreateWindow(AWinControl, AParams, Params);
with Params do
pClassName := ListBoxClsName;
// create window
FinishCreateWindow(AWinControl, Params, False);
// listbox is not a transparent control -> no need for parentpainting

18
lcl/lcltype.pp
View File

@ -931,6 +931,24 @@ const
CBS_SORT = $0100;
CBS_HASSTRINGS = $0200;
{ Listbox style }
LBS_NOTIFY = $0001;
LBS_SORT = $0002;
LBS_NOREDRAW = $0004;
LBS_MULTIPLESEL = $0008;
LBS_OWNERDRAWFIXED = $0010;
LBS_OWNERDRAWVARIABLE = $0020;
LBS_HASSTRINGS = $0040;
LBS_USETABSTOPS = $0080;
LBS_NOINTEGRALHEIGHT = $0100;
LBS_MULTICOLUMN = $0200;
LBS_WANTKEYBOARDINPUT = $0400;
LBS_EXTENDEDSEL = $0800;
LBS_DISABLENOSCROLL = $1000;
LBS_NODATA = $2000;
LBS_NOSEL = $4000;
LBS_STANDARD = $A00003;
const
//==============================================
// SetWindowPos Flags

1
lcl/stdctrls.pp
View File

@ -519,6 +519,7 @@ type
procedure BeginAutoDrag; override;
function CalculateStandardItemHeight: Integer;
procedure Loaded; override;
procedure CreateParams(var Params: TCreateParams); override;
procedure InitializeWnd; override;
procedure FinalizeWnd; override;
class function GetControlClassDefaultSize: TSize; override;