paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-22 16:19:36 +02:00
Code Issues Packages Projects Releases Wiki Activity

implement preferred size calculation for buttons and bitbtns

Browse Source 
seperate text size calculation into general function

git-svn-id: trunk@7746 -
This commit is contained in:
micha 2005-09-19 21:40:26 +00:00
parent 14358611e6
commit 122df55eae
3 changed files with 79 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
lcl/interfaces/win32/win32proc.pp
View File

@ -96,6 +96,7 @@ procedure DisableApplicationWindows(Window: HWND);
procedure EnableApplicationWindows(Window: HWND);
procedure AddToChangedMenus(Window: HWnd);
procedure RedrawMenus;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
type
PDisableWindowsInfo = ^TDisableWindowsInfo;
@ -1073,6 +1074,26 @@ begin
end;
end;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
var
textSize: Windows.SIZE;
winHandle: HWND;
canvasHandle: HDC;
oldFontHandle: HFONT;
begin
winHandle := AWinControl.Handle;
canvasHandle := GetDC(winHandle);
oldFontHandle := SelectObject(canvasHandle, AWinControl.Font.Handle);
Result := Windows.GetTextExtentPoint32(canvasHandle, PChar(Text), Length(Text), textSize);
if Result then
begin
Width := textSize.cx;
Height := textSize.cy;
end;
SelectObject(canvasHandle, oldFontHandle);
ReleaseDC(winHandle, canvasHandle);
end;
{$IFDEF ASSERT_IS_ON}
{$UNDEF ASSERT_IS_ON}

38
lcl/interfaces/win32/win32wsbuttons.pp
View File

@ -56,6 +56,8 @@ type
TWin32WSBitBtn = class(TWSBitBtn)
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer); override;
class procedure SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: integer); override;
class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TBitmap); override;
@ -78,7 +80,7 @@ procedure DrawBitBtnImage(BitBtn: TCustomBitBtn; ButtonCaption: PChar);
implementation
uses
Win32Int, InterfaceBase;
Win32Int, InterfaceBase, Win32Proc;
{ TWin32WSButton }
@ -433,6 +435,40 @@ begin
Result := Params.Window;
end;
procedure TWin32WSBitBtn.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer);
var
BitmapInfo: BITMAP; // Buffer for bitmap
BitBtn: TBitBtn absolute AWinControl;
Glyph: TBitmap;
spacing: integer;
begin
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
Glyph := BitBtn.Glyph;
if not Glyph.Empty then
begin
Windows.GetObject(Glyph.Handle, sizeof(BitmapInfo), @BitmapInfo);
if BitBtn.Spacing = -1 then
spacing := 8
else
spacing := BitBtn.Spacing;
if BitBtn.Layout in [blGlyphLeft, blGlyphRight] then
begin
Inc(PreferredWidth, spacing + BitmapInfo.bmWidth);
if BitmapInfo.bmHeight > PreferredHeight then
PreferredHeight := BitmapInfo.bmHeight;
end else begin
Inc(PreferredHeight, spacing + BitmapInfo.bmHeight);
if BitmapInfo.bmWidth > PreferredWidth then
PreferredWidth := BitmapInfo.bmWidth;
end;
end;
Inc(PreferredWidth, 20);
Inc(PreferredHeight, 12);
end;
end;
procedure TWin32WSBitBtn.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: integer);
begin

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

@ -217,6 +217,8 @@ type
private
protected
public
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer); override;
end;
{ TWin32WSCustomCheckBox }
@ -989,6 +991,18 @@ begin
RecreateWnd(ACustomStaticText);
end;
{ TWin32WSButtonControl }
procedure TWin32WSButtonControl.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer);
begin
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
Inc(PreferredWidth, 20);
Inc(PreferredHeight, 12);
end;
end;
{ TWin32WSCustomCheckBox }
function TWin32WSCustomCheckBox.CreateHandle(const AWinControl: TWinControl;
@ -1016,26 +1030,16 @@ end;
procedure TWin32WSCustomCheckBox.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer);
var
textSize: Windows.SIZE;
winHandle: HWND;
canvasHandle: HDC;
oldFontHandle: HFONT;
text: string;
iconHeight: integer;
begin
winHandle := AWinControl.Handle;
canvasHandle := GetDC(winHandle);
oldFontHandle := SelectObject(canvasHandle, AWinControl.Font.Handle);
text := AWinControl.Caption;
if GetTextExtentPoint32(canvasHandle, PChar(text), Length(text), textSize) then
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
// ~5 pixels spacing between checkbox and text, and 2 pixels margin for rounding error
PreferredWidth := GetSystemMetrics(SM_CXMENUCHECK) - GetSystemMetrics(SM_CXBORDER) + textSize.cx + 7;
PreferredHeight := GetSystemMetrics(SM_CYMENUCHECK) - GetSystemMetrics(SM_CYBORDER);
if textSize.cy > PreferredHeight then
PreferredHeight := textSize.cy;
Inc(PreferredWidth, GetSystemMetrics(SM_CXMENUCHECK) - GetSystemMetrics(SM_CXBORDER) + 7);
iconHeight := GetSystemMetrics(SM_CYMENUCHECK) - GetSystemMetrics(SM_CYBORDER);
if iconHeight > PreferredHeight then
PreferredHeight := iconHeight;
end;
SelectObject(canvasHandle, oldFontHandle);
ReleaseDC(winHandle, canvasHandle);
end;
function TWin32WSCustomCheckBox.RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
@ -1133,7 +1137,7 @@ initialization
RegisterWSComponent(TCustomMemo, TWin32WSCustomMemo);
// RegisterWSComponent(TEdit, TWin32WSEdit);
// RegisterWSComponent(TMemo, TWin32WSMemo);
// RegisterWSComponent(TButtonControl, TWin32WSButtonControl);
RegisterWSComponent(TButtonControl, TWin32WSButtonControl);
RegisterWSComponent(TCustomCheckBox, TWin32WSCustomCheckBox);
// RegisterWSComponent(TCheckBox, TWin32WSCheckBox);
// RegisterWSComponent(TCheckBox, TWin32WSCheckBox);