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