paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-03 19:00:59 +02:00
Code Issues Packages Projects Releases Wiki Activity

added exception handling for createpixmapindirect

Browse Source 
git-svn-id: trunk@2359 -
This commit is contained in:
mattias 2002-08-17 23:41:18 +00:00
parent 4def2008b0
commit 29c3d65cc9
1 changed files with 37 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1744,28 +1744,35 @@ begin
ColorMap:=gdk_window_get_colormap(Window) ColorMap:=gdk_window_get_colormap(Window)
else else
ColorMap:=gdk_colormap_get_system; ColorMap:=gdk_colormap_get_system;
GdiObject^.GDIPixmapObject := try
gdk_pixmap_colormap_create_from_xpm_d(Window,Colormap, GdiObject^.GDIPixmapObject :=
@(GdiObject^.GDIBitmapMaskObject), p, Data); gdk_pixmap_colormap_create_from_xpm_d(Window,Colormap,
@(GdiObject^.GDIBitmapMaskObject), p, Data);
gdk_window_get_geometry(GdiObject^.GDIPixmapObject, nil, nil, nil, nil, @Depth); gdk_window_get_geometry(GdiObject^.GDIPixmapObject, nil, nil, nil, nil, @Depth);
If GdiObject^.Visual <> nil then If GdiObject^.Visual <> nil then
GDK_Visual_UnRef(GdiObject^.Visual); GDK_Visual_UnRef(GdiObject^.Visual);
GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject); GdiObject^.Visual := gdk_window_get_visual(GdiObject^.GDIPixmapObject);
If GdiObject^.Visual = nil then If GdiObject^.Visual = nil then
GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth) GdiObject^.Visual := gdk_visual_get_best_with_depth(Depth)
else else
gdk_visual_ref(GdiObject^.Visual); gdk_visual_ref(GdiObject^.Visual);
If GdiObject^.Colormap <> nil then If GdiObject^.Colormap <> nil then
GDK_Colormap_UnRef(GdiObject^.Colormap); GDK_Colormap_UnRef(GdiObject^.Colormap);
GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, 1); GdiObject^.Colormap := gdk_colormap_new(GdiObject^.Visual, 1);
GdiObject^.GDIBitmapType:=gbPixmap; GdiObject^.GDIBitmapType:=gbPixmap;
except
on E: Exception do begin
DisposeGDIObject(GdiObject);
GdiObject:=nil;
end;
end;
Result := HBITMAP(GdiObject); Result := HBITMAP(GdiObject);
end; end;
@ -2932,8 +2939,8 @@ begin
UseFont:=nil; UseFont:=nil;
if (Str<>nil) and (Count>0) then begin if (Str<>nil) and (Count>0) then begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) then begin if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) then begin
UseFont := GetDefaultFont; UseFont := GetDefaultFont(false);
UnRef := True; UnRef := false;
UnderLine := false; UnderLine := false;
end else begin end else begin
UseFont := CurrentFont^.GDIFontObject; UseFont := CurrentFont^.GDIFontObject;
@ -2941,10 +2948,7 @@ begin
UnderLine := (CurrentFont^.LogFont.lfUnderline<>0); UnderLine := (CurrentFont^.LogFont.lfUnderline<>0);
end; end;
if UseFont = nil then begin if UseFont <> nil then begin
WriteLn('WARNING: [TgtkObject.ExtTextOut] Missing Font');
Result := False;
end else begin
if (Options and ETO_CLIPPED) <> 0 then if (Options and ETO_CLIPPED) <> 0 then
begin begin
X := Rect^.Left; X := Rect^.Left;
@ -2962,6 +2966,9 @@ begin
LineHeight := DCTextMetric.TextMetric.tmAscent; LineHeight := DCTextMetric.TextMetric.tmAscent;
{$EndIf} {$EndIf}
TxtPt.Y := TopY + LineHeight + DCOrigin.Y; TxtPt.Y := TopY + LineHeight + DCOrigin.Y;
end else begin
WriteLn('WARNING: [TgtkObject.ExtTextOut] Missing Font');
Result := False;
end; end;
end; end;
@ -4135,7 +4142,7 @@ var
GDIObj : PGDIObject; GDIObj : PGDIObject;
begin begin
GDIObj := NewGDIObject(gdiFont); GDIObj := NewGDIObject(gdiFont);
GDIObj^.GDIFontObject:= GetDefaultFont; GDIObj^.GDIFontObject:= GetDefaultFont(true);
Result := hFont(GDIObj); Result := hFont(GDIObj);
end; end;
@ -4577,7 +4584,7 @@ begin
begin begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin then begin
UseFont := GetDefaultFont; UseFont := GetDefaultFont(true);
UnRef := True; UnRef := True;
end end
else begin else begin
@ -7788,16 +7795,16 @@ begin
else begin else begin
if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil) if (CurrentFont = nil) or (CurrentFont^.GDIFontObject = nil)
then begin then begin
UseFont := GetDefaultFont; UseFont := GetDefaultFont(true);
UnRef := True;
Underline := False; Underline := False;
StrikeOut := False; StrikeOut := False;
UnRef := True;
end end
else begin else begin
UseFont := CurrentFont^.GDIFontObject; UseFont := CurrentFont^.GDIFontObject;
UnRef := False;
Underline := LongBool(CurrentFont^.LogFont.lfUnderline); Underline := LongBool(CurrentFont^.LogFont.lfUnderline);
StrikeOut := LongBool(CurrentFont^.LogFont.lfStrikeOut); StrikeOut := LongBool(CurrentFont^.LogFont.lfStrikeOut);
UnRef := False;
end; end;
If UseFont = nil then If UseFont = nil then
WriteLn('WARNING: [TgtkObject.TextOut] Missing Font') WriteLn('WARNING: [TgtkObject.TextOut] Missing Font')
@ -8035,6 +8042,9 @@ end;
{ ============================================================================= { =============================================================================
$Log$ $Log$
Revision 1.230 2003/04/03 17:42:13 mattias
added exception handling for createpixmapindirect
Revision 1.229 2003/04/02 13:23:24 mattias Revision 1.229 2003/04/02 13:23:24 mattias
fixed default font fixed default font