paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-10 01:16:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

win32: use better approach to fix MeasureText for bitbtn

Browse Source 
git-svn-id: trunk@18190 -
This commit is contained in:
paul 2009-01-07 15:07:07 +00:00
parent ae9d552d60
commit 12e937579c
3 changed files with 40 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -111,7 +111,7 @@ procedure RestoreStayOnTopFlags(Window: HWND);
procedure AddToChangedMenus(Window: HWnd);
procedure RedrawMenus;
function MeasureText(const AWinControl: TWinControl; Text: string; UseFont: HFont; var Width, Height: integer): boolean;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
function GetControlText(AHandle: HWND): string;
procedure SetMenuFlag(const Menu:HMenu; Flag: Cardinal; Value: boolean);
@ -1246,7 +1246,7 @@ begin
SetMenuItemInfo(Menu, 0, True, @MenuInfo);
end;
function MeasureText(const AWinControl: TWinControl; Text: string; UseFont: HFont; var Width, Height: integer): boolean;
function MeasureText(const AWinControl: TWinControl; Text: string; var Width, Height: integer): boolean;
var
textSize: Windows.SIZE;
winHandle: HWND;
@ -1255,10 +1255,7 @@ var
begin
winHandle := AWinControl.Handle;
canvasHandle := Windows.GetDC(winHandle);
if UseFont = 0 then
newFontHandle := HFONT(SendMessage(winHandle, WM_GETFONT, 0, 0))
else
newFontHandle := UseFont;
newFontHandle := HFONT(SendMessage(winHandle, WM_GETFONT, 0, 0));
oldFontHandle := SelectObject(canvasHandle, newFontHandle);
DeleteAmpersands(Text);

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

@ -1,8 +1,8 @@
{ $Id$}
{
*****************************************************************************
* Win32WSButtons.pp *
* ----------------- *
* Win32WSButtons.pp *
* ----------------- *
* *
* *
*****************************************************************************
@ -29,14 +29,14 @@ interface
uses
////////////////////////////////////////////////////
// I M P O R T A N T
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
CommCtrl, Windows, Classes, Buttons, Graphics, GraphType, Controls,
////////////////////////////////////////////////////
WSProc, WSControls, WSButtons, WSLCLClasses,
WSProc, WSControls, WSButtons, WSLCLClasses,
Win32WSControls, Win32WSImgList, LCLType, Themes;
type
@ -47,7 +47,7 @@ type
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class procedure SetBounds(const AWinControl: TWinControl;
@ -146,7 +146,7 @@ var
ButtonCaptionA: string;
ButtonCaptionW: widestring;
{$ENDIF}
procedure DrawBitmap(AState: TButtonState);
var
TextFlags: integer; // flags for caption (enabled or disabled)
@ -247,7 +247,7 @@ begin
BitBtnDC := GetDC(BitBtnHandle);
hdcNewBitmap := CreateCompatibleDC(BitBtnDC);
OldFontHandle := SelectObject(hdcNewBitmap, BitBtn.Font.Reference.Handle);
MeasureText(BitBtn, ButtonCaption, BitBtn.Font.Reference.Handle, TextSize.cx, TextSize.cy);
MeasureText(BitBtn, ButtonCaption, TextSize.cx, TextSize.cy);
// calculate size of new bitmap
case BitBtnLayout of
blGlyphLeft, blGlyphRight:
@ -370,6 +370,32 @@ begin
BitBtn.Invalidate;
end;
function BitBtnWndProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
LParam: Windows.LParam): LResult; stdcall;
var
Info: PWindowInfo;
Control: TWinControl;
begin
Info := GetWindowInfo(Window);
if (Info = nil) or (Info^.WinControl = nil) then
begin
Result := CallDefaultWindowProc(Window, Msg, WParam, LParam);
Exit;
end
else
Control := Info^.WinControl;
case Msg of
WM_GETFONT:
begin
Result := Control.Font.Reference.Handle;
end;
else
Result := WindowProc(Window, Msg, WParam, LParam);
end;
end;
class function TWin32WSBitBtn.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
@ -387,6 +413,7 @@ begin
Flags := Flags or BS_PUSHBUTTON;
Flags := Flags or BS_BITMAP;
WindowTitle := '';
SubClassWndProc := @BitBtnWndProc;
end;
// create window
FinishCreateWindow(AWinControl, Params, false);
@ -401,7 +428,7 @@ var
Glyph: TBitmap;
spacing, srcWidth: integer;
begin
if MeasureText(AWinControl, AWinControl.Caption, 0, PreferredWidth, PreferredHeight) then
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
Glyph := BitBtn.Glyph;
if not Glyph.Empty then

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

@ -1353,7 +1353,7 @@ end;
class procedure TWin32WSButtonControl.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
if MeasureText(AWinControl, AWinControl.Caption, 0, PreferredWidth, PreferredHeight) then
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
Inc(PreferredWidth, 20);
Inc(PreferredHeight, 4);
@ -1437,7 +1437,7 @@ class procedure TWin32WSCustomCheckBox.GetPreferredSize(const AWinControl: TWinC
var
iconHeight: integer;
begin
if MeasureText(AWinControl, AWinControl.Caption, 0, PreferredWidth, PreferredHeight) then
if MeasureText(AWinControl, AWinControl.Caption, PreferredWidth, PreferredHeight) then
begin
Inc(PreferredWidth, GetSystemMetrics(SM_CXMENUCHECK));
// pixels spacing between checkbox and text