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

Fixes bug #15058, correctly initializes fonts in WinCE

Browse Source 
git-svn-id: trunk@22531 -
This commit is contained in:
sekelsenmat 2009-11-11 16:34:15 +00:00
parent 25b091dfef
commit 1103031807
1 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
lcl/interfaces/wince/winceobject.inc
View File

@ -34,19 +34,24 @@
Constructor for the class. Constructor for the class.
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
constructor TWinCEWidgetSet.Create; constructor TWinCEWidgetSet.Create;
var
Font: THandle;
begin begin
inherited Create; inherited Create;
FTimerData := TList.Create; FTimerData := TList.Create;
// Metrics always fail because SPI_GETNONCLIENTMETRICS doesn't exist under WinCE
// So we need to get the fonts by other means
FMetrics.cbSize := SizeOf(FMetrics); FMetrics.cbSize := SizeOf(FMetrics);
//roozbeh:new stuff seems to be always true as we dont have that flag under ce??!!
FMetricsFailed := True; FMetricsFailed := True;
//FMetricsFailed := not Windows.SystemParametersInfo(SPI_GETNONCLIENTMETRICS,
// SizeOf(FMetrics), @FMetrics, 0);
if FMetricsFailed then
begin
FMetrics.iMenuHeight := GetSystemMetrics(SM_CYMENU); FMetrics.iMenuHeight := GetSystemMetrics(SM_CYMENU);
end; Font := GetStockObject(SYSTEM_FONT); // MSDN Docs say its not necessary to destroy results from GetStockObject
//roozbeh what does it mean?! GetObject(Font, SizeOf(FMetrics.lfMessageFont), @FMetrics.lfMessageFont);
GetObject(Font, SizeOf(FMetrics.lfCaptionFont), @FMetrics.lfCaptionFont);
GetObject(Font, SizeOf(FMetrics.lfStatusFont), @FMetrics.lfStatusFont);
GetObject(Font, SizeOf(FMetrics.lfMenuFont), @FMetrics.lfMenuFont);
WinCEWidgetSet := Self; WinCEWidgetSet := Self;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------
@ -137,14 +142,12 @@ begin
FStockDkGrayBrush := Windows.CreateSolidBrush($404040); FStockDkGrayBrush := Windows.CreateSolidBrush($404040);
FStockWhiteBrush := Windows.CreateSolidBrush($FFFFFF); FStockWhiteBrush := Windows.CreateSolidBrush($FFFFFF);
if FMetricsFailed then // From bug 15058: DEFAULT_GUI_FONT fails in some devices and in the emulator too
begin // It isn't even in the WinCE GetStockObject MSDN Docs and is strongly recommended
FStatusFont := Windows.GetStockObject(DEFAULT_GUI_FONT); // against in Win32 Docs. SYSTEM_FONT is also recommended against in Win32 Docs,
FMessageFont := Windows.GetStockObject(DEFAULT_GUI_FONT); // but it seams to work in Windows CE
end else begin FStatusFont := Windows.GetStockObject(SYSTEM_FONT);
FStatusFont := Windows.CreateFontIndirect(@FMetrics.lfStatusFont); FMessageFont := Windows.GetStockObject(SYSTEM_FONT);
FMessageFont := Windows.CreateFontIndirect(@FMetrics.lfMessageFont);
end;
// Create parent of all windows, 'button on taskbar' // Create parent of all windows, 'button on taskbar'
// The AppHandle window is necessary for popupmenus and // The AppHandle window is necessary for popupmenus and
@ -160,6 +163,9 @@ begin
// set nice main icon // set nice main icon
SendMessage(FAppHandle, WM_SETICON, ICON_BIG, SendMessage(FAppHandle, WM_SETICON, ICON_BIG,
Windows.LoadIcon(MainInstance, 'MAINICON')); Windows.LoadIcon(MainInstance, 'MAINICON'));
// Felipe: This commented code looks unnecessary to me
// remove useless menuitems from sysmenu // remove useless menuitems from sysmenu
// SysMenu := Windows.GetSystemMenu(FAppHandle, False); // SysMenu := Windows.GetSystemMenu(FAppHandle, False);
// Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND); // Windows.DeleteMenu(SysMenu, SC_MAXIMIZE, MF_BYCOMMAND);