paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-05-28 17:42:54 +02:00
Code Issues Packages Projects Releases Wiki Activity

fixed system fonts for win32 intf

Browse Source 
git-svn-id: trunk@4533 -
This commit is contained in:
mattias 2003-08-27 08:14:37 +00:00
parent 0bc0aeb46a
commit 312703c997
7 changed files with 58 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
designer/objectinspector.pp
View File

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

15
lcl/include/canvas.inc
View File

@ -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

2
lcl/include/inputdialog.inc
View File

@ -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;

6
lcl/include/promptdialog.inc
View File

@ -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

9
lcl/interfaces/gtk/gtkwinapi.inc
View File

@ -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

33
lcl/interfaces/win32/win32object.inc
View File

@ -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

11
lcl/interfaces/win32/win32winapi.inc
View File

@ -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