Changeset 315 for trunk/Packages/Common/PixelPointer.pas
- Timestamp:
- Jun 19, 2024, 11:15:44 PM (5 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/PixelPointer.pas
r314 r315 1 unit UPixelPointer;1 unit PixelPointer; 2 2 3 3 interface 4 4 5 5 uses 6 Classes, SysUtils, Graphics;6 Math, Classes, SysUtils, Graphics; 7 7 8 8 type 9 9 TColor32 = type Cardinal; 10 10 TColor32Component = (ccBlue, ccGreen, ccRed, ccAlpha); 11 TColor32Planes = array[0..3] of Byte; 11 12 12 13 { TPixel32 } … … 14 15 TPixel32 = packed record 15 16 private 16 procedure SetRGB(AValue: Cardinal); 17 function GetRGB: Cardinal; 17 procedure SetRGB(AValue: Cardinal); inline; 18 function GetRGB: Cardinal; inline; 18 19 public 20 class function CreateRGB(R, G, B: Byte): TPixel32; static; 21 class function CreateRGBA(R, G, B, A: Byte): TPixel32; static; 19 22 property RGB: Cardinal read GetRGB write SetRGB; 20 23 case Integer of 21 24 0: (B, G, R, A: Byte); 22 25 1: (ARGB: TColor32); 23 2: (Planes: array[0..3] of Byte);26 2: (Planes: TColor32Planes); 24 27 3: (Components: array[TColor32Component] of Byte); 25 28 end; … … 29 32 30 33 TPixelPointer = record 34 private 35 function GetPixelARGB: TColor32; inline; 36 function GetPixelB: Byte; inline; 37 function GetPixelG: Byte; inline; 38 function GetPixelPlane(Index: Byte): Byte; inline; 39 function GetPixelR: Byte; inline; 40 function GetPixelA: Byte; inline; 41 function GetPixelPlanes: TColor32Planes; 42 function GetPixelRGB: Cardinal; inline; 43 procedure SetPixelARGB(Value: TColor32); inline; 44 procedure SetPixelB(Value: Byte); inline; 45 procedure SetPixelG(Value: Byte); inline; 46 procedure SetPixelPlane(Index: Byte; AValue: Byte); inline; 47 procedure SetPixelR(Value: Byte); inline; 48 procedure SetPixelA(Value: Byte); inline; 49 procedure SetPixelRGB(Value: Cardinal); inline; 50 public 31 51 Base: PPixel32; 32 52 Pixel: PPixel32; … … 35 55 BytesPerPixel: Integer; 36 56 BytesPerLine: Integer; 57 Data: PPixel32; 58 Width: Integer; 59 Height: Integer; 37 60 procedure NextLine; inline; // Move pointer to start of next line 38 61 procedure PreviousLine; inline; // Move pointer to start of previous line … … 41 64 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 42 65 procedure SetX(X: Integer); inline; // Set horizontal pixel position relative to base 66 procedure CheckRange; inline; // Check if current pixel position is not out of range 67 function PosValid: Boolean; 68 class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static; 69 property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB; 70 property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB; 71 property PixelB: Byte read GetPixelB write SetPixelB; 72 property PixelG: Byte read GetPixelG write SetPixelG; 73 property PixelR: Byte read GetPixelR write SetPixelR; 74 property PixelA: Byte read GetPixelA write SetPixelA; 75 property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane; 43 76 end; 44 77 PPixelPointer = ^TPixelPointer; 45 78 46 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;47 79 function SwapRedBlue(Color: TColor32): TColor32; 48 80 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint); … … 60 92 function ColorToColor32(Color: TColor): TColor32; 61 93 94 62 95 implementation 63 96 97 resourcestring 98 SOutOfRange = 'Pixel pointer out of range [X: %d, Y: %d, Width: %d, Height: %d]'; 99 SWrongBitmapSize = 'Wrong bitmap size [width: %d, height: %d]'; 100 64 101 { TPixel32 } 65 102 … … 69 106 end; 70 107 108 class function TPixel32.CreateRGB(R, G, B: Byte): TPixel32; 109 begin 110 Result.R := R; 111 Result.G := G; 112 Result.B := B; 113 Result.A := 0; 114 end; 115 116 class function TPixel32.CreateRGBA(R, G, B, A: Byte): TPixel32; 117 begin 118 Result.R := R; 119 Result.G := G; 120 Result.B := B; 121 Result.A := A; 122 end; 123 71 124 procedure TPixel32.SetRGB(AValue: Cardinal); 72 125 begin 73 R := (AValue shr 16) and $ff; 74 G := (AValue shr 8) and $ff; 75 B := (AValue shr 0) and $ff; 126 ARGB := (ARGB and $ff000000) or (AValue and $ffffff); 76 127 end; 77 128 … … 111 162 end; 112 163 164 procedure TPixelPointer.CheckRange; 165 {$IFOPT R+} 166 var 167 X: Integer; 168 Y: Integer; 169 {$ENDIF} 170 begin 171 {$IFOPT R+} 172 if (PByte(Pixel) < PByte(Data)) or 173 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin 174 X := PByte(Pixel) - PByte(Data); 175 Y := Floor(X / BytesPerLine); 176 X := X - Y * BytesPerLine; 177 X := Floor(X / BytesPerPixel); 178 raise Exception.Create(Format(SOutOfRange, [X, Y, Width, Height])); 179 end; 180 {$ENDIF} 181 end; 182 183 function TPixelPointer.PosValid: Boolean; 184 begin 185 Result := not ((PByte(Pixel) < PByte(Data)) or 186 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine)); 187 end; 188 189 function TPixelPointer.GetPixelPlanes: TColor32Planes; 190 begin 191 CheckRange; 192 Result := Pixel^.Planes; 193 end; 194 195 function TPixelPointer.GetPixelRGB: Cardinal; 196 begin 197 CheckRange; 198 Result := Pixel^.RGB; 199 end; 200 201 procedure TPixelPointer.SetPixelARGB(Value: TColor32); 202 begin 203 CheckRange; 204 Pixel^.ARGB := Value; 205 end; 206 207 procedure TPixelPointer.SetPixelB(Value: Byte); 208 begin 209 CheckRange; 210 Pixel^.B := Value; 211 end; 212 213 procedure TPixelPointer.SetPixelG(Value: Byte); 214 begin 215 CheckRange; 216 Pixel^.G := Value; 217 end; 218 219 procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte); 220 begin 221 CheckRange; 222 Pixel^.Planes[Index] := AValue; 223 end; 224 225 procedure TPixelPointer.SetPixelR(Value: Byte); 226 begin 227 CheckRange; 228 Pixel^.R := Value; 229 end; 230 231 procedure TPixelPointer.SetPixelA(Value: Byte); 232 begin 233 CheckRange; 234 Pixel^.A := Value; 235 end; 236 237 function TPixelPointer.GetPixelARGB: TColor32; 238 begin 239 CheckRange; 240 Result := Pixel^.ARGB; 241 end; 242 243 function TPixelPointer.GetPixelB: Byte; 244 begin 245 CheckRange; 246 Result := Pixel^.B; 247 end; 248 249 function TPixelPointer.GetPixelG: Byte; 250 begin 251 CheckRange; 252 Result := Pixel^.G; 253 end; 254 255 function TPixelPointer.GetPixelPlane(Index: Byte): Byte; 256 begin 257 CheckRange; 258 Result := Pixel^.Planes[Index]; 259 end; 260 261 function TPixelPointer.GetPixelR: Byte; 262 begin 263 CheckRange; 264 Result := Pixel^.R; 265 end; 266 267 function TPixelPointer.GetPixelA: Byte; 268 begin 269 CheckRange; 270 Result := Pixel^.A; 271 end; 272 273 procedure TPixelPointer.SetPixelRGB(Value: Cardinal); 274 begin 275 CheckRange; 276 Pixel^.RGB := Value; 277 end; 278 113 279 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; 114 280 SrcBitmap: TRasterImage; SrcPos: TPoint); … … 119 285 SrcBitmap.BeginUpdate(True); 120 286 DstBitmap.BeginUpdate(True); 121 SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);122 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);287 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y); 288 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 123 289 for Y := 0 to DstRect.Height - 1 do begin 124 290 for X := 0 to DstRect.Width - 1 do begin 125 DstPtr.Pixel ^.ARGB := SrcPtr.Pixel^.ARGB;291 DstPtr.PixelARGB := SrcPtr.PixelARGB; 126 292 SrcPtr.NextPixel; 127 293 DstPtr.NextPixel; … … 149 315 SrcBitmap.BeginUpdate(True); 150 316 DstBitmap.BeginUpdate(True); 151 SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);152 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);317 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top); 318 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 153 319 for Y := 0 to DstRect.Height - 1 do begin 154 320 for X := 0 to DstRect.Width - 1 do begin … … 159 325 DstPtr.SetXY(X, Y); 160 326 SrcPtr.SetXY(R.Left, R.Top); 161 C := SrcPtr.Pixel ^.ARGB;162 DstPtr.Pixel ^.ARGB := C;327 C := SrcPtr.PixelARGB; 328 DstPtr.PixelARGB := C; 163 329 for YY := 0 to R.Height - 1 do begin 164 330 for XX := 0 to R.Width - 1 do begin 165 DstPtr.Pixel ^.ARGB := C;331 DstPtr.PixelARGB := C; 166 332 DstPtr.NextPixel; 167 333 end; … … 180 346 begin 181 347 Bitmap.BeginUpdate(True); 182 Ptr := PixelPointer(Bitmap);348 Ptr := TPixelPointer.Create(Bitmap); 183 349 for Y := 0 to Bitmap.Height - 1 do begin 184 350 for X := 0 to Bitmap.Width - 1 do begin 185 Ptr.Pixel ^.ARGB := Color;351 Ptr.PixelARGB := Color; 186 352 Ptr.NextPixel; 187 353 end; … … 197 363 begin 198 364 Bitmap.BeginUpdate(True); 199 Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);365 Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top); 200 366 for Y := 0 to Rect.Height - 1 do begin 201 367 for X := 0 to Rect.Width - 1 do begin 202 Ptr.Pixel ^.ARGB := Color;368 Ptr.PixelARGB := Color; 203 369 Ptr.NextPixel; 204 370 end; … … 214 380 begin 215 381 Bitmap.BeginUpdate(True); 216 Ptr := PixelPointer(Bitmap);382 Ptr := TPixelPointer.Create(Bitmap); 217 383 for Y := 0 to Bitmap.Height - 1 do begin 218 384 for X := 0 to Bitmap.Width - 1 do begin 219 Ptr.Pixel ^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);385 Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB); 220 386 Ptr.NextPixel; 221 387 end; … … 231 397 begin 232 398 Bitmap.BeginUpdate(True); 233 Ptr := PixelPointer(Bitmap);399 Ptr := TPixelPointer.Create(Bitmap); 234 400 for Y := 0 to Bitmap.Height - 1 do begin 235 401 for X := 0 to Bitmap.Width - 1 do begin 236 Ptr.Pixel ^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;402 Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff; 237 403 Ptr.NextPixel; 238 404 end; … … 251 417 Pixel := Color32ToPixel32(Color); 252 418 Bitmap.BeginUpdate(True); 253 Ptr := PixelPointer(Bitmap);419 Ptr := TPixelPointer.Create(Bitmap); 254 420 for Y := 0 to Bitmap.Height - 1 do begin 255 421 for X := 0 to Bitmap.Width - 1 do begin 256 A := Ptr.Pixel ^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;257 R := (Ptr.Pixel ^.R + Pixel.R) shr 1;258 G := (Ptr.Pixel ^.G + Pixel.G) shr 1;259 B := (Ptr.Pixel ^.B + Pixel.B) shr 1;260 Ptr.Pixel ^.ARGB := Color32(A, R, G, B);422 A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1; 423 R := (Ptr.PixelR + Pixel.R) shr 1; 424 G := (Ptr.PixelG + Pixel.G) shr 1; 425 B := (Ptr.PixelB + Pixel.B) shr 1; 426 Ptr.PixelARGB := Color32(A, R, G, B); 261 427 Ptr.NextPixel; 262 428 end; … … 294 460 end; 295 461 296 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;462 class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer; 297 463 BaseY: Integer): TPixelPointer; 298 464 begin 465 Result.Width := Bitmap.Width; 466 Result.Height := Bitmap.Height; 467 if (Result.Width < 0) or (Result.Height < 0) then 468 raise Exception.Create(Format(SWrongBitmapSize, [Result.Width, Result.Height])); 299 469 Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 300 470 Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 471 Result.Data := PPixel32(Bitmap.RawImage.Data); 301 472 Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel + 302 473 BaseY * Result.BytesPerLine); … … 309 480 end; 310 481 311 312 482 end. 313
Note:
See TracChangeset
for help on using the changeset viewer.