fixed system fonts for win32 intf

git-svn-id: trunk@4533 -

designer/objectinspector.pp

@@ -2157,6 +2157,7 @@ begin
   FComponentTreeHeight:=100;
   FShowComponentTree:=true;
   FUsePairSplitter:=TPairSplitter.IsSupportedByInterface;
+  BorderStyle:=bsSizeToolWin;
 
   // StatusBar
   StatusBar:=TStatusBar.Create(Self);

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
+  If Style.SystemFont then
-    RequiredState([csHandleValid]);
-    SelectObject(Self.Handle, GetStockObject(SYSTEM_FONT));
     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
 

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;

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
 

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
 

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
 

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