source: trunk/Packages/DpiControls/Dpi.PixelPointer.pas

Last change on this file was 539, checked in by chronos, 3 months ago
  • Modified: Optimized scaled bitmap drawing.
File size: 12.1 KB
Line 
1unit Dpi.PixelPointer;
2
3interface
4
5uses
6 Math, Classes, SysUtils, Dpi.Graphics, Dpi.Common;
7
8type
9 TColor32 = type Cardinal;
10 TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha);
11 TColor32Planes = array[0..3] of Byte;
12
13 { TPixel32 }
14
15 TPixel32 = packed record
16 private
17 procedure SetRGB(AValue: Cardinal); inline;
18 function GetRGB: Cardinal; inline;
19 public
20 property RGB: Cardinal read GetRGB write SetRGB;
21 case Integer of
22 0: (B, G, R, A: Byte);
23 1: (ARGB: TColor32);
24 2: (Planes: TColor32Planes);
25 3: (Components: array[TColor32Component] of Byte);
26 end;
27 PPixel32 = ^TPixel32;
28
29 { TPixelPointer }
30
31 TPixelPointer = record
32 private
33 function GetPixelARGB: TColor32; inline;
34 function GetPixelB: Byte; inline;
35 function GetPixelG: Byte; inline;
36 function GetPixelPlane(Index: Byte): Byte; inline;
37 function GetPixelR: Byte; inline;
38 function GetPixelA: Byte; inline;
39 function GetPixelPlanes: TColor32Planes;
40 function GetPixelRGB: Cardinal; inline;
41 procedure SetPixelARGB(Value: TColor32); inline;
42 procedure SetPixelB(Value: Byte); inline;
43 procedure SetPixelG(Value: Byte); inline;
44 procedure SetPixelPlane(Index: Byte; AValue: Byte); inline;
45 procedure SetPixelR(Value: Byte); inline;
46 procedure SetPixelA(Value: Byte); inline;
47 procedure SetPixelRGB(Value: Cardinal); inline;
48 public
49 Base: PPixel32;
50 Pixel: PPixel32;
51 Line: PPixel32;
52 RelLine: PPixel32;
53 BytesPerPixel: Integer;
54 BytesPerLine: Integer;
55 Data: PPixel32;
56 Width: Integer;
57 Height: Integer;
58 procedure NextLine; inline; // Move pointer to start of next line
59 procedure PreviousLine; inline; // Move pointer to start of previous line
60 procedure NextPixel; inline; // Move pointer to next pixel
61 procedure PreviousPixel; inline; // Move pointer to previous pixel
62 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base
63 procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base
64 procedure CheckRange; inline; // Check if current pixel position is not out of range
65 function PosValid: Boolean;
66 class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static;
67 property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB;
68 property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB;
69 property PixelB: Byte read GetPixelB write SetPixelB;
70 property PixelG: Byte read GetPixelG write SetPixelG;
71 property PixelR: Byte read GetPixelR write SetPixelR;
72 property PixelA: Byte read GetPixelA write SetPixelA;
73 property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane;
74 end;
75 PPixelPointer = ^TPixelPointer;
76
77 function SwapRedBlue(Color: TColor32): TColor32;
78 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint);
79 procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
80 SrcBitmap: TRasterImage; SrcRect: TRect);
81 procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
82 procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
83 procedure BitmapSwapRedBlue(Bitmap:TRasterImage);
84 procedure BitmapInvert(Bitmap: TRasterImage);
85 procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
86 function Color32(A, R, G, B: Byte): TColor32;
87 function Color32ToPixel32(Color: TColor32): TPixel32;
88 function Pixel32ToColor32(Color: TPixel32): TColor32;
89 function Color32ToColor(Color: TColor32): TColor;
90 function ColorToColor32(Color: TColor): TColor32;
91
92
93implementation
94
95resourcestring
96 SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]';
97 SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]';
98
99{ TPixel32 }
100
101function TPixel32.GetRGB: Cardinal;
102begin
103 Result := ARGB and $ffffff;
104end;
105
106procedure TPixel32.SetRGB(AValue: Cardinal);
107begin
108 ARGB := (ARGB and $ff000000) or (AValue and $ffffff);
109end;
110
111{ TPixelPointer }
112
113procedure TPixelPointer.NextLine; inline;
114begin
115 Line := Pointer(Line) + BytesPerLine;
116 Pixel := Line;
117end;
118
119procedure TPixelPointer.PreviousLine;
120begin
121 Line := Pointer(Line) - BytesPerLine;
122 Pixel := Line;
123end;
124
125procedure TPixelPointer.NextPixel; inline;
126begin
127 Pixel := Pointer(Pixel) + BytesPerPixel;
128end;
129
130procedure TPixelPointer.PreviousPixel;
131begin
132 Pixel := Pointer(Pixel) - BytesPerPixel;
133end;
134
135procedure TPixelPointer.SetXY(X, Y: Integer); inline;
136begin
137 Line := Pointer(Base) + Y * BytesPerLine;
138 SetX(X);
139end;
140
141procedure TPixelPointer.SetX(X: Integer); inline;
142begin
143 Pixel := Pointer(Line) + X * BytesPerPixel;
144end;
145
146procedure TPixelPointer.CheckRange;
147{$IFOPT R+}
148var
149 X: Integer;
150 Y: Integer;
151{$ENDIF}
152begin
153 {$IFOPT R+}
154 if (PByte(Pixel) < PByte(Data)) or
155 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin
156 X := PByte(Pixel) - PByte(Data);
157 Y := Floor(X / BytesPerLine);
158 X := X - Y * BytesPerLine;
159 X := Floor(X / BytesPerPixel);
160 raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height]));
161 end;
162 {$ENDIF}
163end;
164
165function TPixelPointer.PosValid: Boolean;
166begin
167 Result := not ((PByte(Pixel) < PByte(Data)) or
168 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine));
169end;
170
171function TPixelPointer.GetPixelPlanes: TColor32Planes;
172begin
173 CheckRange;
174 Result := Pixel^.Planes;
175end;
176
177function TPixelPointer.GetPixelRGB: Cardinal;
178begin
179 CheckRange;
180 Result := Pixel^.RGB;
181end;
182
183procedure TPixelPointer.SetPixelARGB(Value: TColor32);
184begin
185 CheckRange;
186 Pixel^.ARGB := Value;
187end;
188
189procedure TPixelPointer.SetPixelB(Value: Byte);
190begin
191 CheckRange;
192 Pixel^.B := Value;
193end;
194
195procedure TPixelPointer.SetPixelG(Value: Byte);
196begin
197 CheckRange;
198 Pixel^.G := Value;
199end;
200
201procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte);
202begin
203 CheckRange;
204 Pixel^.Planes[Index] := AValue;
205end;
206
207procedure TPixelPointer.SetPixelR(Value: Byte);
208begin
209 CheckRange;
210 Pixel^.R := Value;
211end;
212
213procedure TPixelPointer.SetPixelA(Value: Byte);
214begin
215 CheckRange;
216 Pixel^.A := Value;
217end;
218
219function TPixelPointer.GetPixelARGB: TColor32;
220begin
221 CheckRange;
222 Result := Pixel^.ARGB;
223end;
224
225function TPixelPointer.GetPixelB: Byte;
226begin
227 CheckRange;
228 Result := Pixel^.B;
229end;
230
231function TPixelPointer.GetPixelG: Byte;
232begin
233 CheckRange;
234 Result := Pixel^.G;
235end;
236
237function TPixelPointer.GetPixelPlane(Index: Byte): Byte;
238begin
239 CheckRange;
240 Result := Pixel^.Planes[Index];
241end;
242
243function TPixelPointer.GetPixelR: Byte;
244begin
245 CheckRange;
246 Result := Pixel^.R;
247end;
248
249function TPixelPointer.GetPixelA: Byte;
250begin
251 CheckRange;
252 Result := Pixel^.A;
253end;
254
255procedure TPixelPointer.SetPixelRGB(Value: Cardinal);
256begin
257 CheckRange;
258 Pixel^.RGB := Value;
259end;
260
261procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect;
262 SrcBitmap: TRasterImage; SrcPos: TPoint);
263var
264 SrcPtr, DstPtr: TPixelPointer;
265 X, Y: Integer;
266begin
267 SrcBitmap.BeginUpdate(True);
268 DstBitmap.BeginUpdate(True);
269 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y);
270 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
271 for Y := 0 to DstRect.Height - 1 do begin
272 for X := 0 to DstRect.Width - 1 do begin
273 DstPtr.PixelARGB := SrcPtr.PixelARGB;
274 SrcPtr.NextPixel;
275 DstPtr.NextPixel;
276 end;
277 SrcPtr.NextLine;
278 DstPtr.NextLine;
279 end;
280 SrcBitmap.EndUpdate;
281 DstBitmap.EndUpdate;
282end;
283
284procedure BitmapStretchRect(DstBitmap: TRasterImage; DstRect: TRect;
285 SrcBitmap: TRasterImage; SrcRect: TRect);
286var
287 SrcPtr, DstPtr: TPixelPointer;
288 X, Y: Integer;
289 XX, YY: Integer;
290 R: TRect;
291 C: TColor32;
292begin
293 if (DstRect.Width = SrcRect.Width) and (DstRect.Height = SrcRect.Height) then begin
294 BitmapCopyRect(DstBitmap, DstRect, SrcBitmap, Point(SrcRect.Left, SrcRect.Top));
295 Exit;
296 end;
297 SrcBitmap.BeginUpdate(True);
298 DstBitmap.BeginUpdate(True);
299 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top);
300 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top);
301 for Y := 0 to DstRect.Height - 1 do begin
302 for X := 0 to DstRect.Width - 1 do begin
303 R := Rect(Trunc(X * SrcRect.Width / DstRect.Width),
304 Trunc(Y * SrcRect.Height / DstRect.Height),
305 Trunc((X + 1) * SrcRect.Width / DstRect.Width),
306 Trunc((Y + 1) * SrcRect.Height / DstRect.Height));
307 DstPtr.SetXY(X, Y);
308 SrcPtr.SetXY(R.Left, R.Top);
309 C := SrcPtr.PixelARGB;
310 DstPtr.PixelARGB := C;
311 for YY := 0 to R.Height - 1 do begin
312 for XX := 0 to R.Width - 1 do begin
313 DstPtr.PixelARGB := C;
314 DstPtr.NextPixel;
315 end;
316 DstPtr.NextLine;
317 end;
318 end;
319 end;
320 SrcBitmap.EndUpdate;
321 DstBitmap.EndUpdate;
322end;
323
324procedure BitmapFill(Bitmap: TRasterImage; Color: TColor32);
325var
326 X, Y: Integer;
327 Ptr: TPixelPointer;
328begin
329 Bitmap.BeginUpdate(True);
330 Ptr := TPixelPointer.Create(Bitmap);
331 for Y := 0 to Bitmap.Height - 1 do begin
332 for X := 0 to Bitmap.Width - 1 do begin
333 Ptr.PixelARGB := Color;
334 Ptr.NextPixel;
335 end;
336 Ptr.NextLine;
337 end;
338 Bitmap.EndUpdate;
339end;
340
341procedure BitmapFillRect(Bitmap: TRasterImage; Color: TColor32; Rect: TRect);
342var
343 X, Y: Integer;
344 Ptr: TPixelPointer;
345begin
346 Bitmap.BeginUpdate(True);
347 Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top);
348 for Y := 0 to Rect.Height - 1 do begin
349 for X := 0 to Rect.Width - 1 do begin
350 Ptr.PixelARGB := Color;
351 Ptr.NextPixel;
352 end;
353 Ptr.NextLine;
354 end;
355 Bitmap.EndUpdate;
356end;
357
358procedure BitmapSwapRedBlue(Bitmap: TRasterImage);
359var
360 X, Y: Integer;
361 Ptr: TPixelPointer;
362begin
363 Bitmap.BeginUpdate(True);
364 Ptr := TPixelPointer.Create(Bitmap);
365 for Y := 0 to Bitmap.Height - 1 do begin
366 for X := 0 to Bitmap.Width - 1 do begin
367 Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB);
368 Ptr.NextPixel;
369 end;
370 Ptr.NextLine;
371 end;
372 Bitmap.EndUpdate;
373end;
374
375procedure BitmapInvert(Bitmap: TRasterImage);
376var
377 X, Y: Integer;
378 Ptr: TPixelPointer;
379begin
380 Bitmap.BeginUpdate(True);
381 Ptr := TPixelPointer.Create(Bitmap);
382 for Y := 0 to Bitmap.Height - 1 do begin
383 for X := 0 to Bitmap.Width - 1 do begin
384 Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff;
385 Ptr.NextPixel;
386 end;
387 Ptr.NextLine;
388 end;
389 Bitmap.EndUpdate;
390end;
391
392procedure BitmapBlendColor(Bitmap: TRasterImage; Color: TColor32);
393var
394 X, Y: Integer;
395 Ptr: TPixelPointer;
396 A, R, G, B: Word;
397 Pixel: TPixel32;
398begin
399 Pixel := Color32ToPixel32(Color);
400 Bitmap.BeginUpdate(True);
401 Ptr := TPixelPointer.Create(Bitmap);
402 for Y := 0 to Bitmap.Height - 1 do begin
403 for X := 0 to Bitmap.Width - 1 do begin
404 A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1;
405 R := (Ptr.PixelR + Pixel.R) shr 1;
406 G := (Ptr.PixelG + Pixel.G) shr 1;
407 B := (Ptr.PixelB + Pixel.B) shr 1;
408 Ptr.PixelARGB := Color32(A, R, G, B);
409 Ptr.NextPixel;
410 end;
411 Ptr.NextLine;
412 end;
413 Bitmap.EndUpdate;
414end;
415
416function Color32(A, R, G, B: Byte): TColor32;
417begin
418 Result := ((A and $ff) shl 24) or ((R and $ff) shl 16) or
419 ((G and $ff) shl 8) or ((B and $ff) shl 0);
420end;
421
422function Color32ToPixel32(Color: TColor32): TPixel32;
423begin
424 Result.ARGB := Color;
425end;
426
427function Pixel32ToColor32(Color: TPixel32): TColor32;
428begin
429 Result := Color.ARGB;
430end;
431
432function Color32ToColor(Color: TColor32): TColor;
433begin
434 Result := ((Color shr 16) and $ff) or (Color and $00ff00) or
435 ((Color and $ff) shl 16);
436end;
437
438function ColorToColor32(Color: TColor): TColor32;
439begin
440 Result := $ff000000 or ((Color shr 16) and $ff) or (Color and $00ff00) or
441 ((Color and $ff) shl 16);
442end;
443
444class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer;
445 BaseY: Integer): TPixelPointer;
446begin
447 Result.Width := ScaleToNative(Bitmap.Width);
448 Result.Height := ScaleToNative(Bitmap.Height);
449 if (Result.Width < 0) or (Result.Height < 0) then
450 raise Exception.Create(Format(SWrongBitmapSize, [Result.Width, Result.Height]));
451 Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine;
452 Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3;
453 Result.Data := PPixel32(Bitmap.RawImage.Data);
454 Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel +
455 BaseY * Result.BytesPerLine);
456 Result.SetXY(0, 0);
457end;
458
459function SwapRedBlue(Color: TColor32): TColor32;
460begin
461 Result := (Color and $ff00ff00) or ((Color and $ff) shl 16) or ((Color shr 16) and $ff);
462end;
463
464end.
Note: See TracBrowser for help on using the repository browser.