1{ $Id$ } 2{ 3 ---------------------------------- 4 gtkdebug.pp - graphic dump utils 5 ---------------------------------- 6 7 @created(Wed May 10th WET 2007) 8 @lastmod($Date$) 9 @author(Marc Weustink <marc@@lazarus.dommelstein.net>) 10 11 This unit contains utility functions to show the contents of graphics 12 13 ***************************************************************************** 14 This file is part of the Lazarus Component Library (LCL) 15 16 See the file COPYING.modifiedLGPL.txt, included in this distribution, 17 for details about the license. 18 ***************************************************************************** 19} 20 21unit Gtk2Debug; 22 23{$mode objfpc}{$H+} 24 25interface 26 27uses 28 // RTL 29 gdk2pixbuf, gdk2, gtk2, 30 sysutils; 31 32procedure DbgDumpBitmap(ABitmap: PGdkBitmap; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 33procedure DbgDumpPixmap(APixmap: PGdkPixmap; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 34procedure DbgDumpPixbuf(APixbuf: PGdkPixbuf; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 35// do not debug images on gtk1, we cannot ref, unref them and thus we cannot rely that they will not be destroyed 36procedure DbgDumpImage(AImage: PGdkImage; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 37 38implementation 39 40type 41 TDbgDumpType = (ddtBitmap, ddtPixmap, ddtPixbuf, ddtImage); 42 43 PDbgDumpInfo = ^TDbgDumpInfo; 44 TDbgDumpInfo = record 45 Width, Height: Integer; 46 case DumpType: TDbgDumpType of 47 ddtBitmap: (Bitmap: PGdkBitmap); 48 ddtPixmap: (Pixmap: PGdkPixmap); 49 ddtPixbuf: (Pixbuf: PGdkPixbuf); 50 ddtImage: (Image: PGdkImage); 51 end; 52 53procedure OnDbgWindowDestroy({%H-}widget: PGtkWidget; Data: Pointer); cdecl; 54var 55 Info: PDbgDumpInfo absolute Data; 56begin 57 case Info^.DumpType of 58 ddtBitmap: if Info^.Bitmap <> nil then gdk_pixmap_unref(Info^.Bitmap); 59 ddtPixmap: if Info^.Pixmap <> nil then gdk_pixmap_unref(Info^.Pixmap); 60 ddtPixbuf: if Info^.Pixbuf <> nil then gdk_pixbuf_unref(Info^.Pixbuf); 61 ddtImage: if Info^.Image <> nil then gdk_image_unref(Info^.Image); 62 end; 63 Dispose(Info); 64end; 65 66procedure OnDbgDrawAreaExpose(widget: PGtkWidget; {%H-}event: PGdkEventExpose; Data: Pointer); cdecl; 67var 68 Info: PDbgDumpInfo absolute Data; 69 gc: Pointer; 70 color: TGdkColor; 71begin 72 gc := gdk_gc_new(widget^.window); 73 74 case Info^.DumpType of 75 ddtBitmap: begin 76 if Info^.Bitmap = nil 77 then color.pixel := $808080 78 else color.pixel := 0; 79 gdk_gc_set_foreground(gc, @color); 80 gdk_draw_rectangle(widget^.window, gc, 1, 0, 0, Info^.Width, Info^.Height); 81 82 if Info^.Bitmap <> nil 83 then begin 84 gdk_gc_set_clip_mask(gc, Info^.Bitmap); 85 color.pixel := $FFFFFF; 86 gdk_gc_set_foreground(gc, @color); 87 gdk_draw_rectangle(widget^.window, gc, 1, 0, 0, Info^.Width, Info^.Height); 88 end; 89 end; 90 ddtPixmap: begin 91 if Info^.Pixmap <> nil 92 then gdk_draw_pixmap(widget^.window, gc, Info^.Pixmap, 0, 0, 0, 0, Info^.Width, Info^.Height); 93 end; 94 ddtPixbuf: begin 95 if Info^.Pixbuf <> nil 96 then gdk_pixbuf_render_to_drawable_alpha(Info^.Pixbuf, widget^.window, 0, 0, 0, 0, Info^.Width, Info^.Height, GDK_PIXBUF_ALPHA_BILEVEL, $80, GDK_RGB_DITHER_NORMAL, 0, 0); 97 end; 98 ddtImage: begin 99 if Info^.Image <> nil 100 then gdk_draw_image(widget^.window, gc, Info^.Image, 0, 0, 0, 0, Info^.Width, Info^.Height); 101 end; 102 end; 103 104 gdk_gc_destroy(gc); 105end; 106 107procedure DbgCreateWindow(AInfo: PDbgDumpInfo; const ATitle: String); 108var 109 window, darea: Pointer; 110begin 111 window := gtk_window_new(GTK_WINDOW_TOPLEVEL); 112 gtk_window_set_title(window, PChar(ATitle)); 113 gtk_window_set_default_size(window, AInfo^.Width, AInfo^.Height); 114 115 darea := gtk_drawing_area_new; 116 gtk_drawing_area_size (darea, AInfo^.Width, AInfo^.Height); 117 gtk_container_add(window, darea); 118 119 gtk_signal_connect(darea, 'expose-event', TGTKSignalFunc(@OnDbgDrawAreaExpose), AInfo); 120 gtk_signal_connect(window, 'destroy', TGTKSignalFunc(@OnDbgWindowDestroy), AInfo); 121 122 gtk_widget_show_all(window); 123end; 124 125procedure DbgDumpBitmap(ABitmap: PGdkBitmap; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 126var 127 Info: PDbgDumpInfo; 128 h,w,d: Integer; 129begin 130 New(Info); 131 if ABitmap = nil 132 then begin 133 w := 0; h:= 0; d := 0; 134 end 135 else 136 gdk_drawable_get_size(ABitmap, @w, @h); 137 d := gdk_drawable_get_depth(ABitmap); 138 139 if AWidth = -1 then AWidth := W; 140 if AHeight = -1 then AHeight := H; 141 Info^.Width := AWidth; 142 Info^.Height := AHeight; 143 if d = 1 144 then begin 145 Info^.DumpType := ddtBitmap; 146 Info^.Bitmap := ABitmap; 147 end 148 else begin 149 // got a pixmap as bitmap 150 Info^.DumpType := ddtPixmap; 151 Info^.Pixmap := ABitmap; 152 end; 153 gdk_pixmap_ref(ABitmap); 154 155 ATitle := ATitle + Format(' (Bitmap:$%p W:%d H:%d D:%d)', [ABitmap, w, h, d]); 156 DbgCreateWindow(Info, ATitle); 157end; 158 159procedure DbgDumpPixmap(APixmap: PGdkPixmap; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 160var 161 Info: PDbgDumpInfo; 162 h,w,d: Integer; 163begin 164 New(Info); 165 if APixmap = nil 166 then begin 167 w := 0; h:= 0; d := 0; 168 end 169 else 170 gdk_drawable_get_size(APixmap, @w, @h); 171 d := gdk_drawable_get_depth(APixmap); 172 173 if AWidth = -1 then AWidth := W; 174 if AHeight = -1 then AHeight := H; 175 Info^.Width := AWidth; 176 Info^.Height := AHeight; 177 if d = 1 178 then begin 179 // got a bitmap as pixmap 180 Info^.DumpType := ddtBitmap; 181 Info^.Bitmap := APixmap; 182 end 183 else begin 184 Info^.DumpType := ddtPixmap; 185 Info^.Pixmap := APixmap; 186 end; 187 gdk_pixmap_ref(APixmap); 188 189 ATitle := ATitle + Format(' (Pixmap:$%p W:%d H:%d D:%d)', [APixmap, w, h, d]); 190 DbgCreateWindow(Info, ATitle); 191end; 192 193procedure DbgDumpPixbuf(APixbuf: PGdkPixbuf; ATitle: String = ''; AWidth: Integer = -1; AHeight: Integer = -1); 194var 195 Info: PDbgDumpInfo; 196 h,w,c: Integer; 197begin 198 New(Info); 199 c := gdk_pixbuf_get_n_channels(APixbuf); 200 w := gdk_pixbuf_get_width(APixbuf); 201 h := gdk_pixbuf_get_height(APixbuf); 202 203 if AWidth = -1 then AWidth := W; 204 if AHeight = -1 then AHeight := H; 205 Info^.Width := AWidth; 206 Info^.Height := AHeight; 207 Info^.DumpType := ddtPixbuf; 208 Info^.Pixbuf := APixbuf; 209 gdk_pixbuf_ref(APixbuf); 210 211 ATitle := ATitle + Format(' (Pixbuf:$%p W:%d H:%d C:%d)', [APixbuf, w, h, c]); 212 DbgCreateWindow(Info, ATitle); 213end; 214 215procedure DbgDumpImage(AImage: PGdkImage; ATitle: String; AWidth: Integer; 216 AHeight: Integer); 217var 218 Info: PDbgDumpInfo; 219begin 220 New(Info); 221 222 if AWidth = -1 then AWidth := AImage^.width; 223 if AHeight = -1 then AHeight := AImage^.height; 224 225 Info^.Width := AWidth; 226 Info^.Height := AHeight; 227 Info^.DumpType := ddtImage; 228 Info^.Image := AImage; 229 gdk_image_ref(AImage); 230 231 DbgCreateWindow(Info, ATitle); 232end; 233 234end. 235