source: trunk/Packages/bgrabitmap/bgragtkbitmap.pas

Last change on this file was 2, checked in by chronos, 5 years ago
File size: 10.4 KB
Line 
1{
2 /**************************************************************************\
3 bgragtkbitmap.pas
4 -----------------
5 This unit should NOT be added to the 'uses' clause.
6 It contains patches for Gtk.
7
8 ****************************************************************************
9 * *
10 * This file is part of BGRABitmap library which is distributed under the *
11 * modified LGPL. *
12 * *
13 * See the file COPYING.modifiedLGPL.txt, included in this distribution, *
14 * for details about the copyright. *
15 * *
16 * This program is distributed in the hope that it will be useful, *
17 * but WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
19 * *
20 ****************************************************************************
21}
22
23unit BGRAGtkBitmap;
24
25{$mode objfpc}{$H+}
26
27interface
28
29uses
30 Classes, SysUtils, BGRALCLBitmap, Graphics,
31 GraphType;
32
33type
34 { TBGRAGtkBitmap }
35
36 TBGRAGtkBitmap = class(TBGRALCLBitmap)
37 private
38 FPixBuf: Pointer;
39 procedure DrawTransparent(ACanvas: TCanvas; Rect: TRect);
40 procedure DrawOpaque(ACanvas: TCanvas; ARect: TRect; ASourceRect: TRect);
41 procedure DrawOpaque(ACanvas: TCanvas; ARect: TRect);
42 protected
43 procedure ReallocData; override;
44 procedure FreeData; override;
45 public
46 procedure DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
47 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
48 override;
49 procedure DrawPart(ARect: TRect; ACanvas: TCanvas; x, y: integer; Opaque: boolean); override;
50 procedure Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean = True); override;
51 procedure Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean = True); override;
52 procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; AData: Pointer;
53 ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer); overload; override;
54 procedure DataDrawOpaque(ACanvas: TCanvas; ARect: TRect; ADataFirstRow: Pointer;
55 ARowStride: integer; AWidth, AHeight: integer); overload;
56 procedure GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer); override;
57 end;
58
59implementation
60
61uses BGRABitmapTypes, BGRADefaultBitmap, BGRAFilterScanner, LCLType,
62 LCLIntf, IntfGraphics,
63 {$IFDEF LCLgtk2}
64 gdk2, gtk2def, gdk2pixbuf, glib2,
65 {$ENDIF}
66 {$IFDEF LCLgtk}
67 gdk, gtkdef, gtkProc, gdkpixbuf, glib,
68 {$ENDIF}
69 FPImage, Dialogs;
70
71procedure TBGRAGtkBitmap.ReallocData;
72begin
73 {$IFDEF LCLgtk2}
74 If FPixBuf <> nil then g_object_unref(FPixBuf);
75 {$ELSE}
76 If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf);
77 {$ENDIF}
78 FPixBuf := nil;
79 inherited ReallocData;
80 if (FWidth <> 0) and (FHeight <> 0) then
81 begin
82 FPixbuf := gdk_pixbuf_new_from_data(pguchar(FData),
83 GDK_COLORSPACE_RGB, True, 8, Width, Height, Width*Sizeof(TBGRAPixel), nil, nil);
84 if FPixbuf = nil then
85 raise Exception.Create('Error initializing Pixbuf');
86 end;
87end;
88
89procedure TBGRAGtkBitmap.FreeData;
90begin
91 {$IFDEF LCLgtk2}
92 If FPixBuf <> nil then g_object_unref(FPixBuf);
93 {$ELSE}
94 If FPixBuf <> nil then gdk_pixbuf_unref(FPixBuf);
95 {$ENDIF}
96 FPixBuf := nil;
97 inherited FreeData;
98end;
99
100procedure TBGRAGtkBitmap.DrawTransparent(ACanvas: TCanvas; Rect: TRect);
101var DrawWidth,DrawHeight: integer;
102 stretched: TBGRAGtkBitmap;
103 P: TPoint;
104begin
105 DrawWidth := Rect.Right-Rect.Left;
106 DrawHeight := Rect.Bottom-Rect.Top;
107 if (Height = 0) or (Width = 0) or (DrawWidth <= 0) or (DrawHeight <= 0) then
108 exit;
109
110 if (DrawWidth <> Width) or (DrawHeight <> Height) then
111 begin
112 stretched := Resample(DrawWidth,DrawHeight,rmSimpleStretch) as TBGRAGtkBitmap;
113 stretched.DrawTransparent(ACanvas,Rect);
114 stretched.Free;
115 exit;
116 end;
117
118 LoadFromBitmapIfNeeded;
119
120 If not TBGRAPixel_RGBAOrder then SwapRedBlue;
121
122 P := Rect.TopLeft;
123 LPToDP(ACanvas.Handle, P, 1);
124 gdk_pixbuf_render_to_drawable(FPixBuf,
125 TGtkDeviceContext(ACanvas.Handle).Drawable,
126 TGtkDeviceContext(ACanvas.Handle).GC,
127 0,0, P.X,P.Y,
128 Width,Height,
129 GDK_RGB_DITHER_NORMAL,0,0);
130
131 If not TBGRAPixel_RGBAOrder then SwapRedBlue;
132end;
133
134procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; ARect: TRect;
135 ASourceRect: TRect);
136begin
137 DataDrawOpaque(ACanvas,ARect,Data,LineOrder,Width,Height);
138end;
139
140procedure TBGRAGtkBitmap.DrawOpaque(ACanvas: TCanvas; ARect: TRect);
141begin
142 DrawOpaque(ACanvas, ARect, rect(0,0,Width,Height));
143end;
144
145procedure TBGRAGtkBitmap.DataDrawTransparent(ACanvas: TCanvas; Rect: TRect;
146 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
147var
148 TempGtk: TBGRAGtkBitmap;
149 temp: integer;
150begin
151 if (AHeight = 0) or (AWidth = 0) or (Rect.Left = Rect.Right) or
152 (Rect.Top = Rect.Bottom) then
153 exit;
154
155 if Rect.Right < Rect.Left then
156 begin
157 temp := Rect.Left;
158 Rect.Left := Rect.Right;
159 Rect.Right := temp;
160 end;
161
162 if Rect.Bottom < Rect.Top then
163 begin
164 temp := Rect.Top;
165 Rect.Top := Rect.Bottom;
166 Rect.Bottom := temp;
167 end;
168
169 TempGtk := TBGRAGtkBitmap.Create(AWidth, AHeight);
170 Move(AData^,TempGtk.Data^,TempGtk.NbPixels*sizeof(TBGRAPixel));
171 if ALineOrder <> TempGtk.LineOrder then TempGtk.VerticalFlip;
172 TempGtk.DrawTransparent(ACanvas,Rect);
173 TempGtk.Free;
174end;
175
176procedure TBGRAGtkBitmap.DrawPart(ARect: TRect; ACanvas: TCanvas; x,
177 y: integer; Opaque: boolean);
178var
179 rowStride,w,h: Integer;
180begin
181 if Opaque then
182 begin
183 if LineOrder = riloTopToBottom then
184 rowStride := Width*sizeof(TBGRAPixel)
185 else
186 rowStride := -Width*sizeof(TBGRAPixel);
187 w:= ARect.Right-ARect.Left;
188 h:= ARect.Bottom-ARect.Top;
189 DataDrawOpaque(ACanvas, rect(x,y,x+w,y+h), Scanline[ARect.Top]+ARect.Left, rowStride, w,h);
190 end
191 else
192 inherited DrawPart(ARect, ACanvas, x, y, Opaque);
193end;
194
195procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; x, y: integer; Opaque: boolean);
196begin
197 if self = nil then
198 exit;
199 if Opaque then
200 DrawOpaque(ACanvas, Rect(X, Y, X + Width, Y + Height))
201 else
202 DrawTransparent(ACanvas, Rect(X, Y, X + Width, Y + Height));
203end;
204
205procedure TBGRAGtkBitmap.Draw(ACanvas: TCanvas; Rect: TRect; Opaque: boolean);
206begin
207 if self = nil then
208 exit;
209 if Opaque then
210 DrawOpaque(ACanvas, Rect)
211 else
212 DrawTransparent(ACanvas, Rect);
213end;
214
215procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
216 AData: Pointer; ALineOrder: TRawImageLineOrder; AWidth, AHeight: integer);
217var
218 rowStride: Integer;
219 firstRow: Pointer;
220begin
221 if ALineOrder = riloTopToBottom then
222 begin
223 rowStride := AWidth*sizeof(TBGRAPixel);
224 firstRow := AData;
225 end
226 else
227 begin
228 rowStride := -AWidth*sizeof(TBGRAPixel);
229 firstRow := PBGRAPixel(AData) + (AWidth*(AHeight-1));
230 end;
231
232 DataDrawOpaque(ACanvas, ARect, firstRow, rowStride, AWidth, AHeight);
233end;
234
235procedure TBGRAGtkBitmap.DataDrawOpaque(ACanvas: TCanvas; ARect: TRect;
236 ADataFirstRow: Pointer; ARowStride: integer; AWidth, AHeight: integer);
237
238 procedure DataSwapRedBlue;
239 var
240 y: Integer;
241 p: PByte;
242 begin
243 p := PByte(ADataFirstRow);
244 for y := 0 to AHeight-1 do
245 begin
246 TBGRAFilterScannerSwapRedBlue.ComputeFilterAt(PBGRAPixel(p),PBGRAPixel(p),AWidth,False);
247 inc(p, ARowStride);
248 end;
249 end;
250
251 procedure DrawStretched;
252 var
253 dataStart: Pointer;
254 ptr: TBGRAPtrBitmap;
255 stretched: TBGRACustomBitmap;
256 begin
257 if ARowStride < 0 then
258 dataStart := PByte(ADataFirstRow) + ARowStride*(Height-1)
259 else
260 dataStart := ADataFirstRow;
261
262 if ARowStride <> abs(AWidth*sizeof(TBGRAPixel)) then
263 raise exception.Create('DataDrawOpaque not supported when using custom row stride and resample');
264
265 ptr := TBGRAPtrBitmap.Create(AWidth,AHeight,dataStart);
266 if ARowStride < 0 then
267 ptr.LineOrder := riloBottomToTop
268 else
269 ptr.LineOrder := riloTopToBottom;
270 stretched := ptr.Resample(ARect.Right-ARect.Left,ARect.Bottom-ARect.Top);
271 ptr.free;
272 DataDrawOpaque(ACanvas,ARect,stretched.Data,stretched.LineOrder,stretched.Width,stretched.Height);
273 stretched.Free;
274 end;
275
276var
277 temp: integer;
278 pos: TPoint;
279 dest: HDC;
280
281begin
282 if (AHeight = 0) or (AWidth = 0) or (ARect.Left = ARect.Right) or
283 (ARect.Top = ARect.Bottom) then exit;
284
285 if ARect.Right < ARect.Left then
286 begin
287 temp := ARect.Left;
288 ARect.Left := ARect.Right;
289 ARect.Right := temp;
290 end;
291
292 if ARect.Bottom < ARect.Top then
293 begin
294 temp := ARect.Top;
295 ARect.Top := ARect.Bottom;
296 ARect.Bottom := temp;
297 end;
298
299 if (AWidth <> ARect.Right-ARect.Left) or (AHeight <> ARect.Bottom-ARect.Top) then
300 DrawStretched
301 else
302 begin
303 dest := ACanvas.Handle;
304 pos := ARect.TopLeft;
305 LPtoDP(dest, pos, 1);
306 if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;
307 gdk_draw_rgb_32_image(TGtkDeviceContext(dest).Drawable,
308 TGtkDeviceContext(Dest).GC, pos.x,pos.y,
309 AWidth,AHeight, GDK_RGB_DITHER_NORMAL,
310 ADataFirstRow, ARowStride);
311 if not TBGRAPixel_RGBAOrder then DataSwapRedBlue;
312 ACanvas.Changed;
313 end;
314end;
315
316procedure TBGRAGtkBitmap.GetImageFromCanvas(CanvasSource: TCanvas; x, y: integer);
317var
318 subBmp: TBGRACustomBitmap;
319 subRect: TRect;
320 cw,ch: integer;
321 P: TPoint;
322begin
323 cw := CanvasSource.Width;
324 ch := CanvasSource.Height;
325 if (x < 0) or (y < 0) or (x+Width > cw) or
326 (y+Height > ch) then
327 begin
328 FillTransparent;
329 if (x+Width <= 0) or (y+Height <= 0) or
330 (x >= cw) or (y >= ch) then
331 exit;
332
333 if (x > 0) then subRect.Left := x else subRect.Left := 0;
334 if (y > 0) then subRect.Top := y else subRect.Top := 0;
335 if (x+Width > cw) then subRect.Right := cw else
336 subRect.Right := x+Width;
337 if (y+Height > ch) then subRect.Bottom := ch else
338 subRect.Bottom := y+Height;
339
340 subBmp := NewBitmap(subRect.Right-subRect.Left,subRect.Bottom-subRect.Top);
341 subBmp.GetImageFromCanvas(CanvasSource,subRect.Left,subRect.Top);
342 PutImage(subRect.Left-x,subRect.Top-y,subBmp,dmSet);
343 subBmp.Free;
344 exit;
345 end;
346
347 P := Point(x,y);
348 LPToDP(CanvasSource.Handle, P, 1);
349 gdk_pixbuf_get_from_drawable(FPixBuf,
350 TGtkDeviceContext(CanvasSource.Handle).Drawable,
351 nil, P.X,P.Y,0,0,Width,Height);
352 If not TBGRAPixel_RGBAOrder then SwapRedBlue;
353 InvalidateBitmap;
354end;
355
356
357end.
358
359
Note: See TracBrowser for help on using the repository browser.