paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-27 16:40:32 +02:00
Code Issues Packages Projects Releases Wiki Activity

added exception handling for createpixmapindirect

Browse Source 
git-svn-id: trunk@2158 -
This commit is contained in:
mattias 2002-08-17 23:41:03 +00:00
parent f47106f7d9
commit b0deed02d2
1 changed files with 28 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
lcl/interfaces/gtk/gtkobject.inc
View File

@ -6558,17 +6558,7 @@ end;
function TgtkObject.CreateDefaultFont: PGdiObject;
begin
Result := NewGDIObject(gdiFont);
if FDefaultFont = nil then begin
FDefaultFont:=GetDefaultFont;
// gdk_font_load('-adobe-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1');
if FDefaultFont = nil then begin
FDefaultFont:= gdk_font_load ('fixed');
if FDefaultFont = nil then
raise EOutOfResources.Create(rsUnableToLoadDefaultFont);
end;
end;
Result^.GDIFontObject:= FDefaultFont;
gdk_font_ref(Result^.GDIFontObject);
Result^.GDIFontObject:= GetDefaultFont(true);
end;
{------------------------------------------------------------------------------
@ -6615,7 +6605,7 @@ begin
end else begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
UseFont := GetDefaultFont;
UseFont := GetDefaultFont(true);
UnRef := True;
end
else begin
@ -6623,7 +6613,7 @@ begin
UnRef := False;
end;
If UseFont = nil then
WriteLn('WARNING: [TgtkObject.GetTGextMetrics] Missing font')
WriteLn('WARNING: [TgtkObject.GetTextMetrics] Missing font')
else begin
FillChar(DCTextMetric, SizeOf(DCTextMetric), 0);
with DCTextMetric do begin
@ -6650,15 +6640,34 @@ begin
gdk_char_width(UseFont, 'M')); // temp hack
if TextMetric.tmMaxCharWidth<1 then
TextMetric.tmMaxCharWidth:=1;
If UnRef then
GDK_Font_UnRef(UseFont);
end;
If UnRef then
GDK_Font_UnRef(UseFont);
end;
Include(DCFlags,dcfTextMetricsValid);
end;
end;
end;
{------------------------------------------------------------------------------
function TgtkObject.GetDefaultFont(IncreaseReferenceCount: boolean): PGDKFont;
------------------------------------------------------------------------------}
function TgtkObject.GetDefaultFont(IncreaseReferenceCount: boolean): PGDKFont;
begin
if FDefaultFont = nil then begin
FDefaultFont:=LoadDefaultFont;
// gdk_font_load('-adobe-helvetica-medium-r-normal--*-120-*-*-*-*-iso8859-1');
if FDefaultFont = nil then begin
FDefaultFont:= gdk_font_load ('fixed');
if FDefaultFont = nil then
raise EOutOfResources.Create(rsUnableToLoadDefaultFont);
end;
end;
Result:=FDefaultFont;
if IncreaseReferenceCount then
gdk_font_ref(Result);
end;
{------------------------------------------------------------------------------
Function: SetRCFilename
Params: const AValue: string
@ -7024,7 +7033,7 @@ var
with TDeviceContext(DC) do begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin
UseFont := GetDefaultFont;
UseFont := GetDefaultFont(true);
UnRef := True;
end
else begin
@ -7164,6 +7173,9 @@ end;
{ =============================================================================
$Log$
Revision 1.347 2003/04/03 17:42:13 mattias
added exception handling for createpixmapindirect
Revision 1.346 2003/04/02 13:23:24 mattias
fixed default font