From 312703c997bc816c4fb8a89c8b5a70e4d908b97e Mon Sep 17 00:00:00 2001 From: mattias Date: Wed, 27 Aug 2003 08:14:37 +0000 Subject: [PATCH] fixed system fonts for win32 intf git-svn-id: trunk@4533 - --- designer/objectinspector.pp | 1 + lcl/include/canvas.inc | 15 +++++++------ lcl/include/inputdialog.inc | 2 +- lcl/include/promptdialog.inc | 6 +++-- lcl/interfaces/gtk/gtkwinapi.inc | 9 ++++---- lcl/interfaces/win32/win32object.inc | 33 +++++++++++++++++++++++++--- lcl/interfaces/win32/win32winapi.inc | 11 +++++++++- 7 files changed, 58 insertions(+), 19 deletions(-) diff --git a/designer/objectinspector.pp b/designer/objectinspector.pp index f5432d71ce..d5e23b70a9 100644 --- a/designer/objectinspector.pp +++ b/designer/objectinspector.pp @@ -2157,6 +2157,7 @@ begin FComponentTreeHeight:=100; FShowComponentTree:=true; FUsePairSplitter:=TPairSplitter.IsSupportedByInterface; + BorderStyle:=bsSizeToolWin; // StatusBar StatusBar:=TStatusBar.Create(Self); diff --git a/lcl/include/canvas.inc b/lcl/include/canvas.inc index a176f314f0..1f36b688fd 100644 --- a/lcl/include/canvas.inc +++ b/lcl/include/canvas.inc @@ -80,6 +80,9 @@ Begin DH := Dest.Bottom - Dest.Top; DW := Dest.Right - Dest.Left; if (Dh=0) and (DW=0) then exit; + //writeln('TCanvas.CopyRect ',ClassName,' Canvas=',Canvas.ClassName,' ', + // ' Src=',Source.Left,',',Source.Top,',',SW,',',SH, + // ' Dest=',Dest.Left,',',Dest.Top,',',DW,',',DH); StretchBlt(FHandle, Dest.Left, Dest.Top, DW, DH, Canvas.FHandle, Source.Left, Source.Top, SW, SH, CopyMode); end; @@ -748,7 +751,7 @@ begin If Style.SystemFont then begin Options := Options or DT_INTERNAL; RequiredState([csHandleValid]); - SelectObject(Self.Handle, GetStockObject(SYSTEM_FONT)); + SelectObject(Self.Handle, GetStockObject(DEFAULT_GUI_FONT)); end else RequiredState([csHandleValid, csFontValid]); @@ -768,13 +771,8 @@ begin RequiredState([csHandleValid, csBrushValid]); FillRect(fRect); end; - If Style.SystemFont then begin - RequiredState([csHandleValid]); - SelectObject(Self.Handle, GetStockObject(SYSTEM_FONT)); + If Style.SystemFont then SetTextColor(Self.Handle, Font.Color); - end - else - RequiredState([csHandleValid, csFontValid]); DrawText(Self.Handle, pChar(Text), Length(Text), fRect, Options); Changed; end; @@ -1238,6 +1236,9 @@ end; { ============================================================================= $Log$ + Revision 1.52 2003/08/27 08:14:37 mattias + fixed system fonts for win32 intf + Revision 1.51 2003/08/18 19:24:18 mattias fixed TCanvas.Pie diff --git a/lcl/include/inputdialog.inc b/lcl/include/inputdialog.inc index cc08911e36..d3ad68f376 100644 --- a/lcl/include/inputdialog.inc +++ b/lcl/include/inputdialog.inc @@ -36,7 +36,7 @@ begin Caption := InputPrompt; Visible := True; end; - SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT)); + SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT)); GetTextExtentPoint(Canvas.Handle,AVGBuffer,StrLen(AVGBuffer),TSize(AVG)); AVG.X := AVG.X div 52; Position := poScreenCenter; diff --git a/lcl/include/promptdialog.inc b/lcl/include/promptdialog.inc index 757ecc33e9..c900432ff4 100644 --- a/lcl/include/promptdialog.inc +++ b/lcl/include/promptdialog.inc @@ -242,12 +242,11 @@ begin If MSG = '' then MSG := ' '; TextBox := Rect(0,0, Screen.Width div 2,Screen.Height - 100); - SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT)); + SelectObject(Canvas.Handle, GetStockObject(DEFAULT_GUI_FONT)); DrawText(Canvas.Handle, PChar(MSG), Length(MSG), TextBox, DT_WORDBREAK or DT_INTERNAL or DT_CALCRECT); // calculate the width we need to display the buttons - SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT)); GetTextExtentPoint(Canvas.Handle,AVGBuffer,StrLen(AVGBuffer),TSize(AVG)); AVG.X := AVG.X div 52; reqBtnWidth := 0; @@ -376,6 +375,9 @@ end; { $Log$ + Revision 1.7 2003/08/27 08:14:37 mattias + fixed system fonts for win32 intf + Revision 1.6 2003/07/04 10:30:02 mattias removed unused label from Micha diff --git a/lcl/interfaces/gtk/gtkwinapi.inc b/lcl/interfaces/gtk/gtkwinapi.inc index bf8c1bac07..379df441be 100644 --- a/lcl/interfaces/gtk/gtkwinapi.inc +++ b/lcl/interfaces/gtk/gtkwinapi.inc @@ -4574,15 +4574,11 @@ begin DEVICE_DEFAULT_FONT: // Device-dependent font. begin end; *) - DEFAULT_GUI_FONT: // Default font for user interface objects such as menus and dialog boxes. - begin - Result := GetStockObject(SYSTEM_FONT); - end; (* OEM_FIXED_FONT: // Original equipment manufacturer (OEM) dependent fixed-pitch (monospace) font. begin end; *) - SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font. + DEFAULT_GUI_FONT, SYSTEM_FONT: // System font. By default, Windows uses the system font to draw menus, dialog box controls, and text. In Windows versions 3.0 and later, the system font is a proportionally spaced font; earlier versions of Windows used a monospace system font. begin If FStockSystemFont <> 0 then begin //This is a Temporary Hack!!! This DeleteObject(FStockSystemFont); //should really only be done on @@ -8709,6 +8705,9 @@ end; { ============================================================================= $Log$ + Revision 1.271 2003/08/27 08:14:37 mattias + fixed system fonts for win32 intf + Revision 1.270 2003/08/26 08:12:33 mattias applied listbox/combobox patch from Karl diff --git a/lcl/interfaces/win32/win32object.inc b/lcl/interfaces/win32/win32object.inc index c7cf078f2a..79a452a97a 100644 --- a/lcl/interfaces/win32/win32object.inc +++ b/lcl/interfaces/win32/win32object.inc @@ -1796,7 +1796,7 @@ Var Caption : String; CompStyle, Left, Top: Integer; DC: HDC; - Flags: DWord; + Flags,FlagsEx: DWord; Height, Width: Integer; DoSubClass: Boolean; Parent: HWND; @@ -1981,11 +1981,29 @@ Begin Window := CreateFont(LFHeight, LFWidth, LFEscapement, LFOrientation, LFWeight, LFItalic, LFUnderLine, LFStrikeOut, LFCharSet, LFOutPrecision, LFClipPrecision, LFQuality, LFPitchAndFamily, LFFaceName); SetProp(Window, 'Lazarus', Sender); End; - csForm, csHintWindow: + csForm: Begin Assert(False, 'Trace:CreateComponent - Creating a Form Window'); + Flags:= WS_OVERLAPPEDWINDOW or WS_CLIPSIBLINGS or WS_CLIPCHILDREN; + FlagsEx:= 0; + Case TCustomForm(Sender).BorderStyle of + //bsSizeable:; -> Default + bsSingle: + Flags:= Flags and (not WS_THICKFRAME); + bsDialog: + Flags:= Flags and (not (WS_THICKFRAME or WS_MINIMIZEBOX or WS_MAXIMIZEBOX)); + bsNone:;// Need to find how to implement this + bsToolWindow: + Begin + FlagsEx:=WS_EX_TOOLWINDOW; + Flags:= Flags and (not WS_THICKFRAME); + End; + bsSizeToolWin: + FlagsEx:=WS_EX_TOOLWINDOW; + End;//case + try - Window := CreateWindow(ClsName, StrTemp, WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Parent, HMENU(Nil), HInstance, Nil); + Window := CreateWindowEx(FlagsEx,ClsName, StrTemp,Flags, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Parent, HMENU(Nil), HInstance, Nil); except writeln('Exception occured creating window'); end; @@ -2002,6 +2020,12 @@ Begin Exit; End; End; + csHintWindow: + Begin + Window := CreateWindow(ClsName, StrTemp,WS_OVERLAPPEDWINDOW, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, Parent, HMENU(Nil), HInstance, Nil); + SetProp(Window, 'Lazarus', Sender); + DoSubClass := false; + End; csMainForm: Begin Assert(False, 'Trace:CreateComponent - Creating a MainForm for Win32 --------------------------------------'); @@ -2846,6 +2870,9 @@ End; { $Log$ + Revision 1.97 2003/08/27 08:14:37 mattias + fixed system fonts for win32 intf + Revision 1.96 2003/08/26 08:12:33 mattias applied listbox/combobox patch from Karl diff --git a/lcl/interfaces/win32/win32winapi.inc b/lcl/interfaces/win32/win32winapi.inc index 5784b50cff..aa944cc2ba 100644 --- a/lcl/interfaces/win32/win32winapi.inc +++ b/lcl/interfaces/win32/win32winapi.inc @@ -1314,9 +1314,15 @@ End; Retrieves a handle to one of the predefined stock objects. ------------------------------------------------------------------------------} Function TWin32Object.GetStockObject(Value: Integer): LongInt; +Var + StockObj: Integer; Begin Assert(False, Format('Trace:> [TWin32Object.GetStockObject] %d ', [Value])); - Result := Windows.GetStockObject(Value); + If Value = SYSTEM_FONT then + StockObj:= DEFAULT_GUI_FONT + Else + StockObj:= Value; + Result := Windows.GetStockObject(StockObj); Assert(False, Format('Trace:< [TWin32Object.GetStockObject] %d --> 0x%x', [Value, Result])); End; @@ -2425,6 +2431,9 @@ end; { ============================================================================= $Log$ + Revision 1.58 2003/08/27 08:14:37 mattias + fixed system fonts for win32 intf + Revision 1.57 2003/08/26 16:14:21 mattias defaultfont patch from Micha