paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-12-08 17:27:33 +01:00
Code Issues Packages Projects Releases Wiki Activity

lcl: publish TListView.BorderStyle, implement it for win32 (already works for gtk2 issue #0013182)

Browse Source 
git-svn-id: trunk@18732 -
This commit is contained in:
paul 2009-02-17 14:31:56 +00:00
parent 705b320a3a
commit 3e01ab5302
3 changed files with 21 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lcl/comctrls.pp
View File

@ -1002,7 +1002,6 @@ type
function IntfCustomDraw(ATarget: TCustomDrawTarget; AStage: TCustomDrawStage; AItem, ASubItem: Integer; AState: TCustomDrawState; const ARect: PRect): TCustomDrawResult;
protected
property AllocBy: Integer read FAllocBy write SetAllocBy default 0;
property BorderStyle default bsSingle;
property Columns: TListColumns read FColumns write SetColumns;
property ColumnClick: Boolean index Ord(lvpColumnClick) read GetProperty write SetProperty default True;
property DefaultItemHeight: integer read FDefaultItemHeight write SetDefaultItemHeight;
@ -1044,6 +1043,7 @@ type
function FindCaption(StartIndex: Integer; Value: string; Partial, Inclusive, Wrap: Boolean; PartStart: Boolean = True): TListItem;
function GetItemAt(x,y: integer): TListItem;
property BoundingRect: TRect read GetBoundingRect;
property BorderStyle default bsSingle;
property Canvas: TCanvas read FCanvas;
property Checkboxes: Boolean index Ord(lvpCheckboxes) read GetProperty write SetProperty default False;
property Column[AIndex: Integer]: TListColumn read GetColumnFromIndex;
@ -1071,7 +1071,7 @@ type
property Align;
property Anchors;
property BorderSpacing;
// property BorderStyle;
property BorderStyle;
property BorderWidth;
property Checkboxes;
property Color default clWindow;

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

@ -130,6 +130,7 @@ type
class function GetVisibleRowCount(const ALV: TCustomListView): Integer; override;
class procedure SetAllocBy(const ALV: TCustomListView; const AValue: Integer); override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetDefaultItemHeight(const ALV: TCustomListView; const AValue: Integer); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;

19
lcl/interfaces/win32/win32wscustomlistview.inc
View File

@ -488,7 +488,8 @@ begin
pClassName := WC_LISTVIEW;
WindowTitle := StrCaption;
Flags := Flags or LISTVIEWSTYLES[TListView(AWinControl).ViewStyle] or LVS_SINGLESEL or LVS_SHAREIMAGELISTS;
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
if TCustomListView(AWinControl).BorderStyle = bsSingle then
FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
@ -678,6 +679,22 @@ begin
ListView_SetItemCount(ALV.Handle, AValue);
end;
class procedure TWin32WSCustomListView.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
var
Handle: HWND;
StyleEx: PtrInt;
begin
if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetBorder') then
Exit;
Handle := AWinControl.Handle;
StyleEx := GetWindowLong(Handle, GWL_EXSTYLE);
if ABorderStyle = TBorderStyle(bsSingle) Then
StyleEx := StyleEx or WS_EX_CLIENTEDGE
else
StyleEx := StyleEx and not WS_EX_CLIENTEDGE;
SetWindowLong(Handle, GWL_EXSTYLE, StyleEx);
end;
class procedure TWin32WSCustomListView.SetColor(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetColor') then