Changeset 570 for Common/PixelPointer.pas
- Timestamp:
- May 14, 2024, 5:26:00 PM (6 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Common/PixelPointer.pas
r563 r570 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 19 20 property RGB: Cardinal read GetRGB write SetRGB; … … 21 22 0: (B, G, R, A: Byte); 22 23 1: (ARGB: TColor32); 23 2: (Planes: array[0..3] of Byte);24 2: (Planes: TColor32Planes); 24 25 3: (Components: array[TColor32Component] of Byte); 25 26 end; … … 29 30 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 31 49 Base: PPixel32; 32 50 Pixel: PPixel32; … … 35 53 BytesPerPixel: Integer; 36 54 BytesPerLine: Integer; 55 Data: PPixel32; 56 Width: Integer; 57 Height: Integer; 37 58 procedure NextLine; inline; // Move pointer to start of next line 38 59 procedure PreviousLine; inline; // Move pointer to start of previous line … … 41 62 procedure SetXY(X, Y: Integer); inline; // Set pixel position relative to base 42 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; 43 74 end; 44 75 PPixelPointer = ^TPixelPointer; 45 76 46 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; inline;47 77 function SwapRedBlue(Color: TColor32): TColor32; 48 78 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; SrcBitmap: TRasterImage; SrcPos: TPoint); … … 63 93 implementation 64 94 95 resourcestring 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 65 99 { TPixel32 } 66 100 … … 72 106 procedure TPixel32.SetRGB(AValue: Cardinal); 73 107 begin 74 R := (AValue shr 16) and $ff; 75 G := (AValue shr 8) and $ff; 76 B := (AValue shr 0) and $ff; 108 ARGB := (ARGB and $ff000000) or (AValue and $ffffff); 77 109 end; 78 110 … … 112 144 end; 113 145 146 procedure TPixelPointer.CheckRange; 147 {$IFOPT R+} 148 var 149 X: Integer; 150 Y: Integer; 151 {$ENDIF} 152 begin 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} 163 end; 164 165 function TPixelPointer.PosValid: Boolean; 166 begin 167 Result := not ((PByte(Pixel) < PByte(Data)) or 168 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine)); 169 end; 170 171 function TPixelPointer.GetPixelPlanes: TColor32Planes; 172 begin 173 CheckRange; 174 Result := Pixel^.Planes; 175 end; 176 177 function TPixelPointer.GetPixelRGB: Cardinal; 178 begin 179 CheckRange; 180 Result := Pixel^.RGB; 181 end; 182 183 procedure TPixelPointer.SetPixelARGB(Value: TColor32); 184 begin 185 CheckRange; 186 Pixel^.ARGB := Value; 187 end; 188 189 procedure TPixelPointer.SetPixelB(Value: Byte); 190 begin 191 CheckRange; 192 Pixel^.B := Value; 193 end; 194 195 procedure TPixelPointer.SetPixelG(Value: Byte); 196 begin 197 CheckRange; 198 Pixel^.G := Value; 199 end; 200 201 procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte); 202 begin 203 CheckRange; 204 Pixel^.Planes[Index] := AValue; 205 end; 206 207 procedure TPixelPointer.SetPixelR(Value: Byte); 208 begin 209 CheckRange; 210 Pixel^.R := Value; 211 end; 212 213 procedure TPixelPointer.SetPixelA(Value: Byte); 214 begin 215 CheckRange; 216 Pixel^.A := Value; 217 end; 218 219 function TPixelPointer.GetPixelARGB: TColor32; 220 begin 221 CheckRange; 222 Result := Pixel^.ARGB; 223 end; 224 225 function TPixelPointer.GetPixelB: Byte; 226 begin 227 CheckRange; 228 Result := Pixel^.B; 229 end; 230 231 function TPixelPointer.GetPixelG: Byte; 232 begin 233 CheckRange; 234 Result := Pixel^.G; 235 end; 236 237 function TPixelPointer.GetPixelPlane(Index: Byte): Byte; 238 begin 239 CheckRange; 240 Result := Pixel^.Planes[Index]; 241 end; 242 243 function TPixelPointer.GetPixelR: Byte; 244 begin 245 CheckRange; 246 Result := Pixel^.R; 247 end; 248 249 function TPixelPointer.GetPixelA: Byte; 250 begin 251 CheckRange; 252 Result := Pixel^.A; 253 end; 254 255 procedure TPixelPointer.SetPixelRGB(Value: Cardinal); 256 begin 257 CheckRange; 258 Pixel^.RGB := Value; 259 end; 260 114 261 procedure BitmapCopyRect(DstBitmap: TRasterImage; DstRect: TRect; 115 262 SrcBitmap: TRasterImage; SrcPos: TPoint); … … 120 267 SrcBitmap.BeginUpdate(True); 121 268 DstBitmap.BeginUpdate(True); 122 SrcPtr := PixelPointer(SrcBitmap, SrcPos.X, SrcPos.Y);123 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);269 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcPos.X, SrcPos.Y); 270 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 124 271 for Y := 0 to DstRect.Height - 1 do begin 125 272 for X := 0 to DstRect.Width - 1 do begin 126 DstPtr.Pixel ^.ARGB := SrcPtr.Pixel^.ARGB;273 DstPtr.PixelARGB := SrcPtr.PixelARGB; 127 274 SrcPtr.NextPixel; 128 275 DstPtr.NextPixel; … … 150 297 SrcBitmap.BeginUpdate(True); 151 298 DstBitmap.BeginUpdate(True); 152 SrcPtr := PixelPointer(SrcBitmap, SrcRect.Left, SrcRect.Top);153 DstPtr := PixelPointer(DstBitmap, DstRect.Left, DstRect.Top);299 SrcPtr := TPixelPointer.Create(SrcBitmap, SrcRect.Left, SrcRect.Top); 300 DstPtr := TPixelPointer.Create(DstBitmap, DstRect.Left, DstRect.Top); 154 301 for Y := 0 to DstRect.Height - 1 do begin 155 302 for X := 0 to DstRect.Width - 1 do begin … … 160 307 DstPtr.SetXY(X, Y); 161 308 SrcPtr.SetXY(R.Left, R.Top); 162 C := SrcPtr.Pixel ^.ARGB;163 DstPtr.Pixel ^.ARGB := C;309 C := SrcPtr.PixelARGB; 310 DstPtr.PixelARGB := C; 164 311 for YY := 0 to R.Height - 1 do begin 165 312 for XX := 0 to R.Width - 1 do begin 166 DstPtr.Pixel ^.ARGB := C;313 DstPtr.PixelARGB := C; 167 314 DstPtr.NextPixel; 168 315 end; … … 181 328 begin 182 329 Bitmap.BeginUpdate(True); 183 Ptr := PixelPointer(Bitmap);330 Ptr := TPixelPointer.Create(Bitmap); 184 331 for Y := 0 to Bitmap.Height - 1 do begin 185 332 for X := 0 to Bitmap.Width - 1 do begin 186 Ptr.Pixel ^.ARGB := Color;333 Ptr.PixelARGB := Color; 187 334 Ptr.NextPixel; 188 335 end; … … 198 345 begin 199 346 Bitmap.BeginUpdate(True); 200 Ptr := PixelPointer(Bitmap, Rect.Left, Rect.Top);347 Ptr := TPixelPointer.Create(Bitmap, Rect.Left, Rect.Top); 201 348 for Y := 0 to Rect.Height - 1 do begin 202 349 for X := 0 to Rect.Width - 1 do begin 203 Ptr.Pixel ^.ARGB := Color;350 Ptr.PixelARGB := Color; 204 351 Ptr.NextPixel; 205 352 end; … … 215 362 begin 216 363 Bitmap.BeginUpdate(True); 217 Ptr := PixelPointer(Bitmap);364 Ptr := TPixelPointer.Create(Bitmap); 218 365 for Y := 0 to Bitmap.Height - 1 do begin 219 366 for X := 0 to Bitmap.Width - 1 do begin 220 Ptr.Pixel ^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);367 Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB); 221 368 Ptr.NextPixel; 222 369 end; … … 232 379 begin 233 380 Bitmap.BeginUpdate(True); 234 Ptr := PixelPointer(Bitmap);381 Ptr := TPixelPointer.Create(Bitmap); 235 382 for Y := 0 to Bitmap.Height - 1 do begin 236 383 for X := 0 to Bitmap.Width - 1 do begin 237 Ptr.Pixel ^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;384 Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff; 238 385 Ptr.NextPixel; 239 386 end; … … 252 399 Pixel := Color32ToPixel32(Color); 253 400 Bitmap.BeginUpdate(True); 254 Ptr := PixelPointer(Bitmap);401 Ptr := TPixelPointer.Create(Bitmap); 255 402 for Y := 0 to Bitmap.Height - 1 do begin 256 403 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);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); 262 409 Ptr.NextPixel; 263 410 end; … … 295 442 end; 296 443 297 function PixelPointer(Bitmap: TRasterImage; BaseX: Integer;444 class function TPixelPointer.Create(Bitmap: TRasterImage; BaseX: Integer; 298 445 BaseY: Integer): TPixelPointer; 299 446 begin 447 Result.Width := Bitmap.Width; 448 Result.Height := Bitmap.Height; 449 if (Result.Width < 0) or (Result.Height < 0) then 450 raise Exception.Create(Format(SWrongBitmapSize, [Result.Width, Result.Height])); 300 451 Result.BytesPerLine := Bitmap.RawImage.Description.BytesPerLine; 301 452 Result.BytesPerPixel := Bitmap.RawImage.Description.BitsPerPixel shr 3; 453 Result.Data := PPixel32(Bitmap.RawImage.Data); 302 454 Result.Base := PPixel32(Bitmap.RawImage.Data + BaseX * Result.BytesPerPixel + 303 455 BaseY * Result.BytesPerLine);
Note:
See TracChangeset
for help on using the changeset viewer.