paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-18 00:19:15 +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 = TOnSaveGraphicToClipboardFormat =
procedure(Src: TGraphic; ClipboardType: TClipboardType; procedure(Src: TGraphic; ClipboardType: TClipboardType;
FormatID: TClipboardFormat); FormatID: TClipboardFormat);
TOnGetSystemFont = function: HFONT;
var var
OnLoadSaveClipBrdGraphicValid: boolean = false; OnLoadSaveClipBrdGraphicValid: boolean = false;
OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat=nil; OnLoadGraphicFromClipboardFormat: TOnLoadGraphicFromClipboardFormat=nil;
OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat=nil; OnSaveGraphicToClipboardFormat: TOnSaveGraphicToClipboardFormat=nil;
OnGetSystemFont: TOnGetSystemFont = nil;
function TestStreamIsBMP(const AStream: TStream): boolean; function TestStreamIsBMP(const AStream: TStream): boolean;
function TestStreamIsXPM(const AStream: TStream): boolean; function TestStreamIsXPM(const AStream: TStream): boolean;
@ -2460,6 +2462,10 @@ end;
{$I fpimagebitmap.inc} {$I fpimagebitmap.inc}
{$I bitmap.inc} {$I bitmap.inc}
function LocalGetSystemFont: HFont;
begin
Result := GetStockObject(DEFAULT_GUI_FONT);
end;
procedure InterfaceInit; procedure InterfaceInit;
begin begin
@ -2479,6 +2485,7 @@ end;
initialization initialization
UpdateLock := TCriticalSection.Create; UpdateLock := TCriticalSection.Create;
OnGetSystemFont := @LocalGetSystemFont;
RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent); RegisterIntegerConsts(TypeInfo(TColor), @IdentToColor, @ColorToIdent);
RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent); RegisterIntegerConsts(TypeInfo(TFontCharset), @IdentToCharset, @CharsetToIdent);
RegisterInterfaceInitializationHandler(@InterfaceInit); RegisterInterfaceInitializationHandler(@InterfaceInit);

2
lcl/include/canvas.inc
View File

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

6
lcl/include/screen.inc
View File

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