mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-21 15:22:28 +02:00
342 lines
12 KiB
ObjectPascal
342 lines
12 KiB
ObjectPascal
{ $Id$}
|
|
{
|
|
*****************************************************************************
|
|
* Win32WSCheckLst.pp *
|
|
* ------------------ *
|
|
* *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* This file is part of the Lazarus Component Library (LCL) *
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
}
|
|
unit Win32WSCheckLst;
|
|
|
|
{$mode objfpc}{$H+}
|
|
{$i win32defines.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
////////////////////////////////////////////////////
|
|
// I M P O R T A N T
|
|
////////////////////////////////////////////////////
|
|
// To get as little as posible circles,
|
|
// uncomment only when needed for registration
|
|
////////////////////////////////////////////////////
|
|
Windows, Classes, Controls, CheckLst, StdCtrls, Themes, Graphics, LCLType, LCLProc,
|
|
LMessages, LCLMessageGlue,
|
|
////////////////////////////////////////////////////
|
|
WSCheckLst, WSLCLClasses, Win32Int, Win32Proc, Win32WSControls, Win32WSStdCtrls;
|
|
|
|
type
|
|
|
|
{ TWin32WSCustomCheckListBox }
|
|
|
|
TWin32WSCustomCheckListBox = class(TWSCustomCheckListBox)
|
|
published
|
|
class function CreateHandle(const AWinControl: TWinControl;
|
|
const AParams: TCreateParams): TLCLIntfHandle; override;
|
|
class procedure DefaultWndHandler(const AWinControl: TWinControl;
|
|
var AMessage); 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;
|
|
const AIndex: integer): TCheckBoxState; override;
|
|
class procedure SetItemEnabled(const ACheckListBox: TCustomCheckListBox;
|
|
const AIndex: integer; const AEnabled: Boolean); override;
|
|
class procedure SetState(const ACheckListBox: TCustomCheckListBox;
|
|
const AIndex: integer; const AState: TCheckBoxState); override;
|
|
end;
|
|
|
|
|
|
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;
|
|
|
|
var
|
|
Count: LResult;
|
|
Top: Integer;
|
|
ARect: TRect;
|
|
Brush: HBrush;
|
|
begin
|
|
// move checlistbox specific code here
|
|
|
|
case Msg of
|
|
WM_DESTROY:
|
|
begin
|
|
TWin32CheckListBoxStrings.DeleteItemRecords(Window);
|
|
end;
|
|
WM_PAINT,
|
|
WM_PRINTCLIENT:
|
|
begin
|
|
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
|
|
Exit;
|
|
end;
|
|
WM_ERASEBKGND:
|
|
begin
|
|
WindowInfo := GetWin32WindowInfo(Window);
|
|
Count := SendMessage(Window, LB_GETCOUNT, 0, 0);
|
|
if (WindowInfo <> nil) and (WindowInfo^.WinControl <> nil) and
|
|
(Count <> LB_ERR) and (SendMessage(Window, LB_GETITEMRECT, Count - 1, Windows.LParam(@ARect)) <> LB_ERR) then
|
|
begin
|
|
Top := ARect.Bottom;
|
|
Windows.GetClientRect(Window, ARect);
|
|
ARect.Top := Top;
|
|
if not IsRectEmpty(ARect) then
|
|
begin
|
|
Brush := CreateSolidBrush(ColorToRGB(WindowInfo^.WinControl.Color));
|
|
Windows.FillRect(HDC(WParam), ARect, Brush);
|
|
DeleteObject(Brush);
|
|
end;
|
|
Result := 1;
|
|
end
|
|
else
|
|
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
Result := WindowProc(Window, Msg, WParam, LParam);
|
|
|
|
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 procedure TWin32WSCustomCheckListBox.DefaultWndHandler(
|
|
const AWinControl: TWinControl; var AMessage);
|
|
|
|
procedure DrawCheckListBoxItem(CheckListBox: TCheckListBox; Data: PDrawItemStruct);
|
|
const
|
|
ThemeStateMap: array[TCheckBoxState, Boolean] of TThemedButton =
|
|
(
|
|
{cbUnchecked} (tbCheckBoxUncheckedDisabled, tbCheckBoxUncheckedNormal),
|
|
{cbChecked } (tbCheckBoxCheckedDisabled, tbCheckBoxCheckedNormal),
|
|
{cbGrayed } (tbCheckBoxMixedDisabled, tbCheckBoxMixedNormal)
|
|
);
|
|
var
|
|
Enabled, Selected: Boolean;
|
|
Brush: HBRUSH;
|
|
ARect, TextRect: Windows.Rect;
|
|
Details: TThemedElementDetails;
|
|
OldColor: COLORREF;
|
|
OldBkMode: Integer;
|
|
{$ifdef WindowsUnicodeSupport}
|
|
AnsiBuffer: string;
|
|
WideBuffer: widestring;
|
|
{$endif}
|
|
begin
|
|
Selected := (Data^.itemState and ODS_SELECTED) > 0;
|
|
Enabled := CheckListBox.Enabled and CheckListBox.ItemEnabled[Data^.itemID];
|
|
|
|
ARect := Data^.rcItem;
|
|
TextRect := ARect;
|
|
TextRect.Left := TextRect.Left + TextRect.Bottom - TextRect.Top + 4;
|
|
|
|
// fill the background
|
|
if Selected then
|
|
begin
|
|
Brush := Windows.CreateSolidBrush(ColorToRGB(CheckListBox.Color));
|
|
Windows.FillRect(Data^._HDC, Rect(ARect.Left, ARect.Top, TextRect.Left, ARect.Bottom), Brush);
|
|
DeleteObject(Brush);
|
|
|
|
Brush := Windows.CreateSolidBrush(Windows.GetSysColor(COLOR_HIGHLIGHT));
|
|
Windows.FillRect(Data^._HDC, TextRect, Brush);
|
|
DeleteObject(Brush);
|
|
end
|
|
else
|
|
begin
|
|
Brush := Windows.CreateSolidBrush(ColorToRGB(CheckListBox.Color));
|
|
Windows.FillRect(Data^._HDC, ARect, Brush);
|
|
DeleteObject(Brush);
|
|
end;
|
|
|
|
// draw checkbox
|
|
ARect.Right := ARect.Left + ARect.Bottom - ARect.Top;
|
|
|
|
Details := ThemeServices.GetElementDetails(ThemeStateMap[CheckListBox.State[Data^.ItemID], Enabled]);
|
|
ThemeServices.DrawElement(Data^._HDC, Details, ARect);
|
|
|
|
// draw text
|
|
TextRect.Left := TextRect.Left + 2;
|
|
OldBkMode := Windows.SetBkMode(Data^._HDC, TRANSPARENT);
|
|
if not Enabled then
|
|
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(COLOR_GRAYTEXT))
|
|
else
|
|
if Selected then
|
|
OldColor := Windows.SetTextColor(Data^._HDC, Windows.GetSysColor(COLOR_HIGHLIGHTTEXT))
|
|
else
|
|
OldColor := Windows.SetTextColor(Data^._HDC, ColorToRGB(CheckListBox.Font.Color));
|
|
{$ifdef WindowsUnicodeSupport}
|
|
if UnicodeEnabledOS then
|
|
begin
|
|
WideBuffer := UTF8ToUTF16(CheckListBox.Items[Data^.ItemID]);
|
|
Windows.DrawTextW(Data^._HDC, PWideChar(WideBuffer), -1,
|
|
TextRect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
|
|
end
|
|
else
|
|
begin
|
|
AnsiBuffer := Utf8ToAnsi(CheckListBox.Items[Data^.ItemID]);
|
|
Windows.DrawText(Data^._HDC, PChar(AnsiBuffer), -1,
|
|
TextRect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
|
|
end;
|
|
{$else}
|
|
Windows.DrawText(Data^._HDC, PChar(CheckListBox.Items[Data^.ItemID]), -1,
|
|
TextRect, DT_SINGLELINE or DT_VCENTER or DT_NOPREFIX);
|
|
{$endif}
|
|
// restore old colors
|
|
Windows.SetTextColor(Data^._HDC, OldColor);
|
|
Windows.SetBkMode(Data^._HDC, OldBkMode);
|
|
if Enabled and ((Data^.itemState and ODS_FOCUS) > 0) and CheckListBox.Focused then
|
|
begin
|
|
TextRect.Left := TextRect.Left - 2;
|
|
Windows.DrawFocusRect(Data^._HDC, TextRect);
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
case TLMessage(AMessage).Msg of
|
|
LM_DRAWITEM:
|
|
begin
|
|
with TLMDrawItems(AMessage) do
|
|
begin
|
|
// ItemID not UINT(-1)
|
|
if DrawItemStruct^.ItemID <> DWORD($FFFFFFFF) then
|
|
DrawCheckListBoxItem(TCheckListBox(AWinControl), DrawItemStruct);
|
|
end;
|
|
end;
|
|
|
|
LM_MEASUREITEM:
|
|
begin
|
|
with TLMMeasureItem(AMessage).MeasureItemStruct^ do
|
|
begin
|
|
itemHeight := TCustomListBox(AWinControl).ItemHeight;
|
|
if TCustomListBox(AWinControl).Style = lbOwnerDrawVariable then
|
|
TCustomListBox(AWinControl).MeasureItem(Integer(itemID), integer(itemHeight));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
inherited DefaultWndHandler(AWinControl, AMessage);
|
|
end;
|
|
|
|
class function TWin32WSCustomCheckListBox.GetStrings(const ACustomListBox: TCustomListBox): TStrings;
|
|
var
|
|
Handle: HWND;
|
|
begin
|
|
Handle := ACustomListBox.Handle;
|
|
Result := TWin32CheckListBoxStrings.Create(Handle, ACustomListBox);
|
|
GetWin32WindowInfo(Handle)^.List := Result;
|
|
end;
|
|
|
|
class function TWin32WSCustomCheckListBox.GetItemEnabled(
|
|
const ACheckListBox: TCustomCheckListBox; const AIndex: integer): Boolean;
|
|
begin
|
|
Result := TWin32CheckListBoxStrings(ACheckListBox.Items).Enabled[AIndex];
|
|
end;
|
|
|
|
class function TWin32WSCustomCheckListBox.GetState(
|
|
const ACheckListBox: TCustomCheckListBox; const AIndex: integer
|
|
): TCheckBoxState;
|
|
begin
|
|
Result := TWin32CheckListBoxStrings(ACheckListBox.Items).State[AIndex];
|
|
end;
|
|
|
|
class procedure TWin32WSCustomCheckListBox.SetItemEnabled(
|
|
const ACheckListBox: TCustomCheckListBox; const AIndex: integer;
|
|
const AEnabled: Boolean);
|
|
var
|
|
SizeRect: Windows.RECT;
|
|
Handle: HWND;
|
|
begin
|
|
TWin32CheckListBoxStrings(ACheckListBox.Items).Enabled[AIndex] := AEnabled;
|
|
|
|
// redraw control
|
|
Handle := ACheckListBox.Handle;
|
|
Windows.SendMessage(Handle, LB_GETITEMRECT, AIndex, LPARAM(@SizeRect));
|
|
Windows.InvalidateRect(Handle, @SizeRect, False);
|
|
end;
|
|
|
|
class procedure TWin32WSCustomCheckListBox.SetState(
|
|
const ACheckListBox: TCustomCheckListBox; const AIndex: integer;
|
|
const AState: TCheckBoxState);
|
|
var
|
|
SizeRect: Windows.RECT;
|
|
Handle: HWND;
|
|
begin
|
|
TWin32CheckListBoxStrings(ACheckListBox.Items).State[AIndex] := AState;
|
|
|
|
// redraw control
|
|
Handle := ACheckListBox.Handle;
|
|
Windows.SendMessage(Handle, LB_GETITEMRECT, AIndex, LPARAM(@SizeRect));
|
|
Windows.InvalidateRect(Handle, @SizeRect, False);
|
|
end;
|
|
|
|
end.
|