pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

ExCtrls: Fix high-dpi for TCheckComboBoxEx (ButtonWidth)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8139 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2021-11-01 17:39:07 +00:00
parent 2f7c57e770
commit 1e3713b3b2
1 changed files with 21 additions and 27 deletions
Download Patch File Download Diff File Expand all files Collapse all files

48
components/exctrls/source/excheckcombo.pas
View File

@ -5,8 +5,8 @@ unit ExCheckCombo;
interface interface
uses uses
LCLIntf, LCLType, Classes, SysUtils, Contnrs, LCLIntf, LCLType, Classes, SysUtils, Controls, StdCtrls,
Controls, StdCtrls, GroupedEdit, EditBtn, CheckLst, Forms; GroupedEdit, EditBtn, CheckLst, Forms;
type type
{ TCheckComboBoxEx } { TCheckComboBoxEx }
@ -43,10 +43,10 @@ type
private private
FAllowGrayed: Boolean; FAllowGrayed: Boolean;
FAutoDropDown: Boolean; FAutoDropDown: Boolean;
FButtonWidth: Integer;
FCheckListBox: TCheckListBox; FCheckListBox: TCheckListBox;
FDelimiter: Char; FDelimiter: Char;
FDropDownCount: Integer; FDropDownCount: Integer;
//FDropDownForm: TForm;
FDroppedDown: Boolean; FDroppedDown: Boolean;
FEscCancels: Boolean; FEscCancels: Boolean;
FItemIndex: Integer; FItemIndex: Integer;
@ -66,7 +66,6 @@ type
function GetItemEnabled(AIndex: Integer): Boolean; function GetItemEnabled(AIndex: Integer): Boolean;
function GetItems: TStrings; function GetItems: TStrings;
function GetState(AIndex: Integer): TCheckBoxState; function GetState(AIndex: Integer): TCheckBoxState;
function IsButtonWidthStored: Boolean;
procedure ItemClickHandler(Sender: TObject; AIndex: Integer); procedure ItemClickHandler(Sender: TObject; AIndex: Integer);
procedure ItemsToCheckListbox(ACheckListbox: TCheckListbox); procedure ItemsToCheckListbox(ACheckListbox: TCheckListbox);
procedure SetAllowGrayed(AValue: Boolean); procedure SetAllowGrayed(AValue: Boolean);
@ -82,7 +81,8 @@ type
procedure SetState(AIndex: Integer; const AValue: TCheckboxState); procedure SetState(AIndex: Integer; const AValue: TCheckboxState);
protected protected
procedure ButtonClick; override; procedure ButtonClick; override;
procedure CloseUp; procedure CloseUp;
procedure CreateHandle; override;
procedure DoEnter; override; procedure DoEnter; override;
procedure DoChange; virtual; procedure DoChange; virtual;
procedure DoItemChange(AIndex: Integer); virtual; procedure DoItemChange(AIndex: Integer); virtual;
@ -113,7 +113,7 @@ type
published published
property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default false; property AllowGrayed: Boolean read FAllowGrayed write SetAllowGrayed default false;
property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default false; property AutoDropDown: Boolean read FAutoDropDown write FAutoDropDown default false;
property ButtonWidth: Integer read GetButtonWidth write SetButtonWidth stored IsButtonWidthStored; property ButtonWidth: Integer read FButtonWidth write SetButtonWidth default -1;
property Delimiter: char read FDelimiter write SetDelimiter default ';'; property Delimiter: char read FDelimiter write SetDelimiter default ';';
property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8; property DropDownCount: Integer read FDropDownCount write SetDropDownCount default 8;
property EscCancels: Boolean read FEscCancels write FEscCancels default true; property EscCancels: Boolean read FEscCancels write FEscCancels default true;
@ -461,21 +461,10 @@ begin
inherited Create(AOwner); inherited Create(AOwner);
Spacing := 0; Spacing := 0;
Button.Flat := true; Button.Flat := true;
Button.Width := GetSystemMetrics(SM_CXVSCROLL); FButtonWidth := -1;
FDelimiter := ';'; FDelimiter := ';';
FDropDownCount := 8; FDropDownCount := 8;
FItems := TCheckComboBoxExStrings.Create; FItems := TCheckComboBoxExStrings.Create;
(*
FDropDownForm := TCheckComboBoxForm.CreateNew(Self);
with TCheckComboBoxForm(FDropDownForm) do
begin
Self.FCheckListbox := FCheckListbox;
FCaller := self;
OnHide := @CloseUpHandler;
FCheckListbox.OnItemClick := @ItemClickHandler;
Visible := false;
end;
*)
FEscCancels := true; FEscCancels := true;
end; end;
@ -573,6 +562,13 @@ begin
end; end;
} }
procedure TCheckComboBoxEx.CreateHandle;
begin
inherited;
if FButtonWidth < 0 then
Buddy.Width := GetSystemMetrics(SM_CXVSCROLL);
end;
procedure TCheckComboBoxEx.DoChange; procedure TCheckComboBoxEx.DoChange;
begin begin
if Assigned(FOnChange) then FOnChange(self); if Assigned(FOnChange) then FOnChange(self);
@ -665,11 +661,6 @@ begin
Result := FItems.State[AIndex]; Result := FItems.State[AIndex];
end; end;
function TCheckComboBoxEx.IsButtonWidthStored: Boolean;
begin
Result := Buddy.Width <> GetSystemMetrics(SM_CXVSCROLL);
end;
procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer); procedure TCheckComboBoxEx.ItemClickHandler(Sender: TObject; AIndex: Integer);
begin begin
UpdateCaption; UpdateCaption;
@ -750,10 +741,13 @@ end;
procedure TCheckComboBoxEx.SetButtonWidth(AValue: Integer); procedure TCheckComboBoxEx.SetButtonWidth(AValue: Integer);
begin begin
if AValue < 0 then if FButtonWidth = AValue then
AValue := GetSystemMetrics(SM_CXVSCROLL); exit;
if Buddy.Width <> AValue then FButtonWidth := AValue;
Buddy.Width := AValue; if FButtonWidth < 0 then
Buddy.Width := GetSystemMetrics(SM_CXVSCROLL)
else
Buddy.Width := FButtonWidth;
end; end;
procedure TCheckComboBoxEx.SetChecked(AIndex: Integer; const AValue: Boolean); procedure TCheckComboBoxEx.SetChecked(AIndex: Integer; const AValue: Boolean);