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

lcl: use Screen.SystemFont for TCanvas.TextRect

Browse Source 
git-svn-id: trunk@20285 -
This commit is contained in:
paul 2009-05-28 14:23:19 +00:00
parent 3e567f606e
commit 119c2796bf
3 changed files with 14 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/graphics.pp
View File

@ -1798,11 +1798,13 @@ type
TOnSaveGraphicToClipboardFormat =
procedure(Src: TGraphic; ClipboardType: TClipboardType;
FormatID: TClipboardFormat);
TOnGetSystemFont = function: HFONT;
var
OnLoadSaveClipBrdGraphicValid: boolean = false;
OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat=nil;
OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat=nil;
OnGetSystemFont: TOnGetSystemFont = nil;
function TestStreamIsBMP(const AStream: TStream): boolean;
function TestStreamIsXPM(const AStream: TStream): boolean;
@ -2460,6 +2462,10 @@ end;
{$I fpimagebitmap.inc}
{$I bitmap.inc}
function LocalGetSystemFont: HFont;
begin
Result := GetStockObject(DEFAULT_GUI_FONT);
end;
procedure InterfaceInit;
begin
@ -2479,6 +2485,7 @@ end;
initialization
UpdateLock := TCriticalSection.Create;
OnGetSystemFont := @LocalGetSystemFont;
RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
RegisterInterfaceInitializationHandler(@InterfaceInit);

2
lcl/include/canvas.inc
View File

@ -1137,7 +1137,7 @@ begin
if Style.SystemFont then
begin
Options := Options or DT_INTERNAL;
SelectObject(DC, GetStockObject(DEFAULT_GUI_FONT));
SelectObject(DC, OnGetSystemFont());
end;
// calculate text rectangle

6
lcl/include/screen.inc
View File

@ -52,6 +52,11 @@ begin
Result := 1;
end;
function ScreenGetSystemFont: HFont;
begin
Result := Screen.SystemFont.Reference.Handle;
end;
{------------------------------------------------------------------------------
Method: TScreen.Create
Params: AOwner: the owner of the class
@ -75,6 +80,7 @@ begin
AddDataModule := @DoAddDataModule;
RemoveDataModule := @DoRemoveDataModule;
OnGetSystemFont := @ScreenGetSystemFont;
end;
{------------------------------------------------------------------------------