Changeset 506 for trunk/Packages/DpiControls/Dpi.PixelPointer.pas
- Timestamp:
- Dec 25, 2023, 11:35:51 AM (5 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Packages/DpiControls/Dpi.PixelPointer.pas
r501 r506 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; 37 function GetPixelR: Byte; inline; 38 function GetPixelA: Byte; inline; 39 function GetPixelPlanes: TColor32Planes; 40 function GetPixelRGB: Cardinal; 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); 45 procedure SetPixelR(Value: Byte); inline; 46 procedure SetPixelA(Value: Byte); inline; 47 procedure SetPixelRGB(Value: Cardinal); 48 public 31 49 Base: PPixel32; 32 50 Pixel: PPixel32; … … 46 64 procedure CheckRange; inline; // Check if current pixel position is not out of range 47 65 class function Create(Bitmap: TRasterImage; BaseX: Integer = 0; BaseY: Integer = 0): TPixelPointer; static; 66 property PixelARGB: TColor32 read GetPixelARGB write SetPixelARGB; 67 property PixelRGB: Cardinal read GetPixelRGB write SetPixelRGB; 68 property PixelB: Byte read GetPixelB write SetPixelB; 69 property PixelG: Byte read GetPixelG write SetPixelG; 70 property PixelR: Byte read GetPixelR write SetPixelR; 71 property PixelA: Byte read GetPixelA write SetPixelA; 72 property PixelPlane[Index: Byte]: Byte read GetPixelPlane write SetPixelPlane; 48 73 end; 49 74 PPixelPointer = ^TPixelPointer; … … 91 116 Line := Pointer(Line) + BytesPerLine; 92 117 Pixel := Line; 93 CheckRange;94 118 end; 95 119 … … 98 122 Line := Pointer(Line) - BytesPerLine; 99 123 Pixel := Line; 100 CheckRange;101 124 end; 102 125 … … 104 127 begin 105 128 Pixel := Pointer(Pixel) + BytesPerPixel; 106 CheckRange;107 129 end; 108 130 … … 110 132 begin 111 133 Pixel := Pointer(Pixel) - BytesPerPixel; 112 CheckRange;113 134 end; 114 135 … … 122 143 begin 123 144 Pixel := Pointer(Line) + X * BytesPerPixel; 124 CheckRange;125 145 end; 126 146 127 147 procedure TPixelPointer.CheckRange; 148 {$IFOPT R+} 128 149 var 129 150 X: Integer; 130 151 Y: Integer; 152 {$ENDIF} 131 153 begin 132 154 {$IFOPT R+} 133 155 if (PByte(Pixel) < PByte(Data)) or 134 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine + BytesPerLine) then begin156 (PByte(Pixel) >= PByte(Data) + Height * BytesPerLine) then begin 135 157 X := PByte(Pixel) - PByte(Data); 136 158 Y := Floor(X / BytesPerLine); … … 140 162 end; 141 163 {$ENDIF} 164 end; 165 166 function TPixelPointer.GetPixelPlanes: TColor32Planes; 167 begin 168 CheckRange; 169 Result := Pixel^.Planes; 170 end; 171 172 function TPixelPointer.GetPixelRGB: Cardinal; 173 begin 174 CheckRange; 175 Result := Pixel^.RGB; 176 end; 177 178 procedure TPixelPointer.SetPixelARGB(Value: TColor32); 179 begin 180 CheckRange; 181 Pixel^.ARGB := Value; 182 end; 183 184 procedure TPixelPointer.SetPixelB(Value: Byte); 185 begin 186 CheckRange; 187 Pixel^.B := Value; 188 end; 189 190 procedure TPixelPointer.SetPixelG(Value: Byte); 191 begin 192 CheckRange; 193 Pixel^.G := Value; 194 end; 195 196 procedure TPixelPointer.SetPixelPlane(Index: Byte; AValue: Byte); 197 begin 198 CheckRange; 199 Pixel^.Planes[Index] := AValue; 200 end; 201 202 procedure TPixelPointer.SetPixelR(Value: Byte); 203 begin 204 CheckRange; 205 Pixel^.R := Value; 206 end; 207 208 procedure TPixelPointer.SetPixelA(Value: Byte); 209 begin 210 CheckRange; 211 Pixel^.A := Value; 212 end; 213 214 function TPixelPointer.GetPixelARGB: TColor32; 215 begin 216 CheckRange; 217 Result := Pixel^.ARGB; 218 end; 219 220 function TPixelPointer.GetPixelB: Byte; 221 begin 222 CheckRange; 223 Result := Pixel^.B; 224 end; 225 226 function TPixelPointer.GetPixelG: Byte; 227 begin 228 CheckRange; 229 Result := Pixel^.G; 230 end; 231 232 function TPixelPointer.GetPixelPlane(Index: Byte): Byte; 233 begin 234 CheckRange; 235 Result := Pixel^.Planes[Index]; 236 end; 237 238 function TPixelPointer.GetPixelR: Byte; 239 begin 240 CheckRange; 241 Result := Pixel^.R; 242 end; 243 244 function TPixelPointer.GetPixelA: Byte; 245 begin 246 CheckRange; 247 Result := Pixel^.A; 248 end; 249 250 procedure TPixelPointer.SetPixelRGB(Value: Cardinal); 251 begin 252 CheckRange; 253 Pixel^.RGB := Value; 142 254 end; 143 255 … … 154 266 for Y := 0 to DstRect.Height - 1 do begin 155 267 for X := 0 to DstRect.Width - 1 do begin 156 DstPtr.Pixel ^.ARGB := SrcPtr.Pixel^.ARGB;268 DstPtr.PixelARGB := SrcPtr.PixelARGB; 157 269 SrcPtr.NextPixel; 158 270 DstPtr.NextPixel; … … 190 302 DstPtr.SetXY(X, Y); 191 303 SrcPtr.SetXY(R.Left, R.Top); 192 C := SrcPtr.Pixel ^.ARGB;193 DstPtr.Pixel ^.ARGB := C;304 C := SrcPtr.PixelARGB; 305 DstPtr.PixelARGB := C; 194 306 for YY := 0 to R.Height - 1 do begin 195 307 for XX := 0 to R.Width - 1 do begin 196 DstPtr.Pixel ^.ARGB := C;308 DstPtr.PixelARGB := C; 197 309 DstPtr.NextPixel; 198 310 end; … … 214 326 for Y := 0 to Bitmap.Height - 1 do begin 215 327 for X := 0 to Bitmap.Width - 1 do begin 216 Ptr.Pixel ^.ARGB := Color;328 Ptr.PixelARGB := Color; 217 329 Ptr.NextPixel; 218 330 end; … … 231 343 for Y := 0 to Rect.Height - 1 do begin 232 344 for X := 0 to Rect.Width - 1 do begin 233 Ptr.Pixel ^.ARGB := Color;345 Ptr.PixelARGB := Color; 234 346 Ptr.NextPixel; 235 347 end; … … 248 360 for Y := 0 to Bitmap.Height - 1 do begin 249 361 for X := 0 to Bitmap.Width - 1 do begin 250 Ptr.Pixel ^.ARGB := SwapRedBlue(Ptr.Pixel^.ARGB);362 Ptr.PixelARGB := SwapRedBlue(Ptr.PixelARGB); 251 363 Ptr.NextPixel; 252 364 end; … … 265 377 for Y := 0 to Bitmap.Height - 1 do begin 266 378 for X := 0 to Bitmap.Width - 1 do begin 267 Ptr.Pixel ^.ARGB := Ptr.Pixel^.ARGB xor $ffffff;379 Ptr.PixelARGB := Ptr.PixelARGB xor $ffffff; 268 380 Ptr.NextPixel; 269 381 end; … … 285 397 for Y := 0 to Bitmap.Height - 1 do begin 286 398 for X := 0 to Bitmap.Width - 1 do begin 287 A := Ptr.Pixel ^.A; //(Ptr.Pixel^.A + Pixel.A) shr 1;288 R := (Ptr.Pixel ^.R + Pixel.R) shr 1;289 G := (Ptr.Pixel ^.G + Pixel.G) shr 1;290 B := (Ptr.Pixel ^.B + Pixel.B) shr 1;291 Ptr.Pixel ^.ARGB := Color32(A, R, G, B);399 A := Ptr.PixelA; //(Ptr.PixelA + Pixel.A) shr 1; 400 R := (Ptr.PixelR + Pixel.R) shr 1; 401 G := (Ptr.PixelG + Pixel.G) shr 1; 402 B := (Ptr.PixelB + Pixel.B) shr 1; 403 Ptr.PixelARGB := Color32(A, R, G, B); 292 404 Ptr.NextPixel; 293 405 end;
Note:
See TracChangeset
for help on using the changeset viewer.