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