Changeset 30 for trunk/Packages/Common/PixelPointer.pas
- Timestamp:
- Jun 28, 2024, 11:08:43 PM (5 months ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/Common/PixelPointer.pas
r29 r30 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); … … 63 95 implementation 64 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 65 101 { TPixel32 } 66 102 … … 70 106 end; 71 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 72 124 procedure TPixel32.SetRGB(AValue: Cardinal); 73 125 begin 74 R := (AValue shr 16) and $ff; 75 G := (AValue shr 8) and $ff; 76 B := (AValue shr 0) and $ff; 126 ARGB := (ARGB and $ff000000) or (AValue and $ffffff); 77 127 end; 78 128 … … 112 162 end; 113 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 114 279 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; 115 280 SrcBitmap: TRasterImage; SrcPos: TPoint); … … 120 285 SrcBitmap.BeginUpdate(True); 121 286 DstBitmap.BeginUpdate(True); 122 SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);123 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); 124 289 for Y := 0 to DstRect.Height - 1 do begin 125 290 for X := 0 to DstRect.Width - 1 do begin 126 DstPtr.Pixel ^.ARGB := SrcPtr.Pixel^.ARGB;291 DstPtr.PixelARGB := SrcPtr.PixelARGB; 127 292 SrcPtr.NextPixel; 128 293 DstPtr.NextPixel; … … 150 315 SrcBitmap.BeginUpdate(True); 151 316 DstBitmap.BeginUpdate(True); 152 SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);153 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); 154 319 for Y := 0 to DstRect.Height - 1 do begin 155 320 for X := 0 to DstRect.Width - 1 do begin … … 160 325 DstPtr.SetXY(X, Y); 161 326 SrcPtr.SetXY(R.Left, R.Top); 162 C := SrcPtr.Pixel ^.ARGB;163 DstPtr.Pixel ^.ARGB := C;327 C := SrcPtr.PixelARGB; 328 DstPtr.PixelARGB := C; 164 329 for YY := 0 to R.Height - 1 do begin 165 330 for XX := 0 to R.Width - 1 do begin 166 DstPtr.Pixel ^.ARGB := C;331 DstPtr.PixelARGB := C; 167 332 DstPtr.NextPixel; 168 333 end; … … 181 346 begin 182 347 Bitmap.BeginUpdate(True); 183 Ptr := PixelPointer(Bitmap);348 Ptr := TPixelPointer.Create(Bitmap); 184 349 for Y := 0 to Bitmap.Height - 1 do begin 185 350 for X := 0 to Bitmap.Width - 1 do begin 186 Ptr.Pixel ^.ARGB := Color;351 Ptr.PixelARGB := Color; 187 352 Ptr.NextPixel; 188 353 end; … … 198 363 begin 199 364 Bitmap.BeginUpdate(True); 200 Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);365 Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top); 201 366 for Y := 0 to Rect.Height - 1 do begin 202 367 for X := 0 to Rect.Width - 1 do begin 203 Ptr.Pixel ^.ARGB := Color;368 Ptr.PixelARGB := Color; 204 369 Ptr.NextPixel; 205 370 end; … … 215 380 begin 216 381 Bitmap.BeginUpdate(True); 217 Ptr := PixelPointer(Bitmap);382 Ptr := TPixelPointer.Create(Bitmap); 218 383 for Y := 0 to Bitmap.Height - 1 do begin 219 384 for X := 0 to Bitmap.Width - 1 do begin 220 Ptr.Pixel ^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);385 Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB); 221 386 Ptr.NextPixel; 222 387 end; … … 232 397 begin 233 398 Bitmap.BeginUpdate(True); 234 Ptr := PixelPointer(Bitmap);399 Ptr := TPixelPointer.Create(Bitmap); 235 400 for Y := 0 to Bitmap.Height - 1 do begin 236 401 for X := 0 to Bitmap.Width - 1 do begin 237 Ptr.Pixel ^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;402 Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff; 238 403 Ptr.NextPixel; 239 404 end; … … 252 417 Pixel := Color32ToPixel32(Color); 253 418 Bitmap.BeginUpdate(True); 254 Ptr := PixelPointer(Bitmap);419 Ptr := TPixelPointer.Create(Bitmap); 255 420 for Y := 0 to Bitmap.Height - 1 do begin 256 421 for X := 0 to Bitmap.Width - 1 do begin 257 A := Ptr.Pixel ^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;258 R := (Ptr.Pixel ^.R + Pixel.R) shr 1;259 G := (Ptr.Pixel ^.G + Pixel.G) shr 1;260 B := (Ptr.Pixel ^.B + Pixel.B) shr 1;261 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); 262 427 Ptr.NextPixel; 263 428 end; … … 295 460 end; 296 461 297 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;462 class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer; 298 463 BaseY: Integer): TPixelPointer; 299 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])); 300 469 Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 301 470 Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 471 Result.Data := PPixel32(Bitmap.RawImage.Data); 302 472 Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel + 303 473 BaseY * Result.BytesPerLine); … … 310 480 end; 311 481 312 313 482 end. 314
Note:
See TracChangeset
for help on using the changeset viewer.