Rev 1 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed
| Rev 1 | Rev 4 | ||
|---|---|---|---|
| Line -... | Line 1... | ||
| - | 1 | {*******************************************************} |
|
| - | 2 | { } |
|
| - | 3 | { DIB and PAINTBOX componets } |
|
| - | 4 | { } |
|
| - | 5 | { Copyright (C) 1997-2000 Hiroyuki Hori } |
|
| - | 6 | { base components and effects } |
|
| - | 7 | { Copyright (C) 2000 Keith Murray } |
|
| - | 8 | { supernova effect } |
|
| - | 9 | { Copyright (C) 2000 Michel Hibon } |
|
| - | 10 | { new special effects added for DIB } |
|
| - | 11 | { Copyright (C) 2001 Joakim Back } |
|
| - | 12 | { conFusion effects (as DxFusion) } |
|
| - | 13 | { Copyright (C) 2003 Babak Sateli } |
|
| - | 14 | { 24-bit DIB effect as supplement ones } |
|
| - | 15 | { Copyright (C) 2004-2012 Jaro Benes } |
|
| - | 16 | { 32-bit DIB effect with alphachannel } |
|
| - | 17 | { direct works with texture buffer } |
|
| - | 18 | { modified and adapted all adopted functions } |
|
| - | 19 | { } |
|
| - | 20 | {*******************************************************} |
|
| - | 21 | ||
| 1 | unit DIB; |
22 | unit DIB; |
| 2 | 23 | ||
| 3 | interface |
24 | interface |
| 4 | 25 | ||
| 5 | {$INCLUDE DelphiXcfg.inc} |
26 | {$INCLUDE DelphiXcfg.inc} |
| - | 27 | {$DEFINE USE_SCANLINE} |
|
| 6 | 28 | ||
| 7 | uses |
29 | uses |
| 8 | Windows, SysUtils, Classes, Graphics, Controls; |
30 | Windows, SysUtils, Classes, Graphics, Controls, |
| - | 31 | {$IFDEF VER17UP} Types, UITypes,{$ENDIF} |
|
| - | 32 | Math; |
|
| 9 | 33 | ||
| 10 | type |
34 | type |
| - | 35 | TColorLineStyle = (csSolid, csGradient, csRainbow); |
|
| - | 36 | TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular); |
|
| - | 37 | PRGBQuads = ^TRGBQuads; |
|
| 11 | TRGBQuads = array[0..255] of TRGBQuad; |
38 | TRGBQuads = array[0..255] of TRGBQuad; |
| 12 | 39 | ||
| 13 | TPaletteEntries = array[0..255] of TPaletteEntry; |
40 | TPaletteEntries = array[0..255] of TPaletteEntry; |
| 14 | 41 | ||
| 15 | PBGR = ^TBGR; |
42 | PBGR = ^TBGR; |
| 16 | TBGR = packed record |
43 | TBGR = packed record |
| 17 | B, G, R: Byte; |
44 | B, G, R: Byte; |
| 18 | end; |
45 | end; |
| 19 | 46 | ||
| - | 47 | { Added this type for New SPecial Effect } |
|
| - | 48 | TFilter = array[0..2, 0..2] of SmallInt; |
|
| - | 49 | TLines = array[0..0] of TBGR; |
|
| - | 50 | PLines = ^TLines; |
|
| - | 51 | TBytes = array[0..0] of Byte; |
|
| - | 52 | PBytes = ^TBytes; |
|
| - | 53 | TPBytes = array[0..0] of PBytes; |
|
| - | 54 | PPBytes = ^TPBytes; |
|
| - | 55 | { End of type's } |
|
| - | 56 | ||
| 20 | PArrayBGR = ^TArrayBGR; |
57 | PArrayBGR = ^TArrayBGR; |
| 21 | TArrayBGR = array[0..10000] of TBGR; |
58 | TArrayBGR = array[0..10000] of TBGR; |
| 22 | 59 | ||
| 23 | PArrayByte = ^TArrayByte; |
60 | PArrayByte = ^TArrayByte; |
| 24 | TArrayByte = array[0..10000] of Byte; |
61 | TArrayByte = array[0..10000] of Byte; |
| Line 27... | Line 64... | ||
| 27 | TArrayWord = array[0..10000] of Word; |
64 | TArrayWord = array[0..10000] of Word; |
| 28 | 65 | ||
| 29 | PArrayDWord = ^TArrayDWord; |
66 | PArrayDWord = ^TArrayDWord; |
| 30 | TArrayDWord = array[0..10000] of DWord; |
67 | TArrayDWord = array[0..10000] of DWord; |
| 31 | 68 | ||
| 32 | { TDIB } |
69 | { TDIBPixelFormat } |
| 33 | 70 | ||
| 34 | TDIBPixelFormat = record |
71 | TDIBPixelFormat = record |
| 35 | RBitMask, GBitMask, BBitMask: DWORD; |
72 | RBitMask, GBitMask, BBitMask: DWORD; |
| 36 | RBitCount, GBitCount, BBitCount: DWORD; |
73 | RBitCount, GBitCount, BBitCount: DWORD; |
| 37 | RShift, GShift, BShift: DWORD; |
74 | RShift, GShift, BShift: DWORD; |
| 38 | RBitCount2, GBitCount2, BBitCount2: DWORD; |
75 | RBitCount2, GBitCount2, BBitCount2: DWORD; |
| 39 | end; |
76 | end; |
| 40 | 77 | ||
| - | 78 | { TDIBSharedImage } |
|
| - | 79 | ||
| 41 | TDIBSharedImage = class(TSharedImage) |
80 | TDIBSharedImage = class(TSharedImage) |
| 42 | private |
81 | private |
| 43 | FBitCount: Integer; |
82 | FBitCount: Integer; |
| 44 | FBitmapInfo: PBitmapInfo; |
83 | FBitmapInfo: PBitmapInfo; |
| 45 | FBitmapInfoSize: Integer; |
84 | FBitmapInfoSize: Integer; |
| 46 | FChangePalette: Boolean; |
85 | FChangePalette: Boolean; |
| 47 | FColorTable: TRGBQuads; |
86 | FColorTable: TRGBQuads; |
| Line 62... | Line 101... | ||
| 62 | FWidth: Integer; |
101 | FWidth: Integer; |
| 63 | FWidthBytes: Integer; |
102 | FWidthBytes: Integer; |
| 64 | constructor Create; |
103 | constructor Create; |
| 65 | procedure NewImage(AWidth, AHeight, ABitCount: Integer; |
104 | procedure NewImage(AWidth, AHeight, ABitCount: Integer; |
| 66 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
105 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
| 67 | procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
106 | procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF} |
| 68 | procedure Compress(Source: TDIBSharedImage); |
107 | procedure Compress(Source: TDIBSharedImage); |
| 69 | procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
108 | procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
| 70 | procedure ReadData(Stream: TStream; MemoryImage: Boolean); |
109 | procedure ReadData(Stream: TStream; MemoryImage: Boolean); |
| 71 | function GetPalette: THandle; |
110 | function GetPalette: THandle; |
| 72 | procedure SetColorTable(const Value: TRGBQuads); |
111 | procedure SetColorTable(const Value: TRGBQuads); |
| Line 74... | Line 113... | ||
| 74 | procedure FreeHandle; override; |
113 | procedure FreeHandle; override; |
| 75 | public |
114 | public |
| 76 | destructor Destroy; override; |
115 | destructor Destroy; override; |
| 77 | end; |
116 | end; |
| 78 | 117 | ||
| - | 118 | { TFilterTypeResample } |
|
| - | 119 | ||
| - | 120 | TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline, |
|
| - | 121 | ftrLanczos3, ftrMitchell); |
|
| - | 122 | ||
| - | 123 | TDistortType = (dtFast, dtSlow); |
|
| - | 124 | {DXFusion effect type} |
|
| - | 125 | TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75); |
|
| - | 126 | ||
| - | 127 | { TLightSource } |
|
| - | 128 | ||
| - | 129 | TLightSource = record |
|
| - | 130 | X, Y: Integer; |
|
| - | 131 | Size1, Size2: Integer; |
|
| - | 132 | Color: TColor; |
|
| - | 133 | end; |
|
| - | 134 | ||
| - | 135 | { TLightArray } |
|
| - | 136 | ||
| - | 137 | TLightArray = array{$IFNDEF VER4UP} [0..0]{$ENDIF} of TLightsource; |
|
| - | 138 | ||
| - | 139 | { TMatrixSetting } |
|
| - | 140 | ||
| - | 141 | TMatrixSetting = array[0..9] of Integer; |
|
| - | 142 | ||
| - | 143 | { TDIB } |
|
| - | 144 | ||
| 79 | TDIB = class(TGraphic) |
145 | TDIB = class(TGraphic) |
| 80 | private |
146 | private |
| 81 | FCanvas: TCanvas; |
147 | FCanvas: TCanvas; |
| 82 | FImage: TDIBSharedImage; |
148 | FImage: TDIBSharedImage; |
| 83 | 149 | ||
| 84 | FProgressName: string; |
150 | FProgressName: string; |
| 85 | FProgressOldY: DWORD; |
151 | FProgressOldY: DWORD; |
| 86 | FProgressOldTime: DWORD; |
152 | FProgressOldTime: DWORD; |
| 87 | FProgressOld: DWORD; |
153 | FProgressOld: DWORD; |
| Line 94... | Line 160... | ||
| 94 | FPBits: Pointer; |
160 | FPBits: Pointer; |
| 95 | FSize: Integer; |
161 | FSize: Integer; |
| 96 | FTopPBits: Pointer; |
162 | FTopPBits: Pointer; |
| 97 | FWidth: Integer; |
163 | FWidth: Integer; |
| 98 | FWidthBytes: Integer; |
164 | FWidthBytes: Integer; |
| - | 165 | FLUTDist: array[0..255, 0..255] of Integer; |
|
| - | 166 | LG_COUNT: Integer; |
|
| - | 167 | LG_DETAIL: Integer; |
|
| - | 168 | FFreeList: TList; |
|
| 99 | procedure AllocHandle; |
169 | procedure AllocHandle; |
| 100 | procedure CanvasChanging(Sender: TObject); |
170 | procedure CanvasChanging(Sender: TObject); |
| 101 | procedure Changing(MemoryImage: Boolean); |
171 | procedure Changing(MemoryImage: Boolean); |
| 102 | procedure ConvertBitCount(ABitCount: Integer); |
172 | procedure ConvertBitCount(ABitCount: Integer); |
| 103 | function GetBitmapInfo: PBitmapInfo; |
173 | function GetBitmapInfo: PBitmapInfo; |
| Line 111... | Line 181... | ||
| 111 | function GetScanLine(Y: Integer): Pointer; |
181 | function GetScanLine(Y: Integer): Pointer; |
| 112 | function GetScanLineReadOnly(Y: Integer): Pointer; |
182 | function GetScanLineReadOnly(Y: Integer): Pointer; |
| 113 | function GetTopPBits: Pointer; |
183 | function GetTopPBits: Pointer; |
| 114 | function GetTopPBitsReadOnly: Pointer; |
184 | function GetTopPBitsReadOnly: Pointer; |
| 115 | procedure SetBitCount(Value: Integer); |
185 | procedure SetBitCount(Value: Integer); |
| 116 | procedure SetImage(Value: TDIBSharedImage); |
186 | procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF} |
| 117 | procedure SetNowPixelFormat(const Value: TDIBPixelFormat); |
187 | procedure SetNowPixelFormat(const Value: TDIBPixelFormat); |
| 118 | procedure SetPixel(X, Y: Integer; Value: DWORD); |
188 | procedure SetPixel(X, Y: Integer; Value: DWORD); |
| 119 | procedure StartProgress(const Name: string); |
189 | procedure StartProgress(const Name: string); |
| 120 | procedure EndProgress; |
190 | procedure EndProgress; |
| 121 | procedure UpdateProgress(PercentY: Integer); |
191 | procedure UpdateProgress(PercentY: Integer); |
| - | 192 | ||
| - | 193 | { Added these 3 functions for New Specials Effects } |
|
| - | 194 | function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 195 | function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 196 | function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 197 | { End of 3 functions for New Special Effect } |
|
| - | 198 | ||
| - | 199 | procedure Darkness(Amount: Integer); |
|
| - | 200 | function GetAlphaChannel: TDIB; |
|
| - | 201 | procedure SetAlphaChannel(const Value: TDIB); |
|
| - | 202 | function GetClientRect: TRect; |
|
| - | 203 | function GetRGBChannel: TDIB; |
|
| - | 204 | procedure SetRGBChannel(const Value: TDIB); |
|
| 122 | protected |
205 | protected |
| 123 | procedure DefineProperties(Filer: TFiler); override; |
206 | procedure DefineProperties(Filer: TFiler); override; |
| 124 | procedure Draw(ACanvas: TCanvas; const Rect: TRect); override; |
207 | procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; |
| 125 | function GetEmpty: Boolean; override; |
208 | function GetEmpty: Boolean; override; |
| 126 | function GetHeight: Integer; override; |
209 | function GetHeight: Integer; override; |
| 127 | function GetPalette: HPalette; override; |
210 | function GetPalette: HPalette; override; |
| 128 | function GetWidth: Integer; override; |
211 | function GetWidth: Integer; override; |
| 129 | procedure ReadData(Stream: TStream); override; |
212 | procedure ReadData(Stream: TStream); override; |
| Line 139... | Line 222... | ||
| 139 | procedure Assign(Source: TPersistent); override; |
222 | procedure Assign(Source: TPersistent); override; |
| 140 | procedure Clear; |
223 | procedure Clear; |
| 141 | procedure Compress; |
224 | procedure Compress; |
| 142 | procedure Decompress; |
225 | procedure Decompress; |
| 143 | procedure FreeHandle; |
226 | procedure FreeHandle; |
| - | 227 | function HasAlphaChannel: Boolean; |
|
| - | 228 | function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean; |
|
| - | 229 | procedure RetAlphaChannel(out oDIB: TDIB); |
|
| 144 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
230 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
| 145 | APalette: HPALETTE); override; |
231 | APalette: HPALETTE); override; |
| 146 | procedure LoadFromStream(Stream: TStream); override; |
232 | procedure LoadFromStream(Stream: TStream); override; |
| 147 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
233 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
| 148 | var APalette: HPALETTE); override; |
234 | var APalette: HPALETTE); override; |
| 149 | procedure SaveToStream(Stream: TStream); override; |
235 | procedure SaveToStream(Stream: TStream); override; |
| 150 | procedure SetSize(AWidth, AHeight, ABitCount: Integer); |
236 | procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF} |
| 151 | procedure UpdatePalette; |
237 | procedure UpdatePalette; |
| 152 | { Special effect } |
238 | { Special effect } |
| 153 | procedure Blur(ABitCount: Integer; Radius: Integer); |
239 | procedure Blur(ABitCount: Integer; Radius: Integer); |
| 154 | procedure Greyscale(ABitCount: Integer); |
240 | procedure Greyscale(ABitCount: Integer); |
| 155 | procedure Mirror(MirrorX, MirrorY: Boolean); |
241 | procedure Mirror(MirrorX, MirrorY: Boolean); |
| 156 | procedure Negative; |
242 | procedure Negative; |
| 157 | 243 | ||
| - | 244 | { Added New Special Effect } |
|
| - | 245 | procedure Spray(Amount: Integer); |
|
| - | 246 | procedure Emboss; |
|
| - | 247 | procedure AddMonoNoise(Amount: Integer); |
|
| - | 248 | procedure AddGradiantNoise(Amount: byte); |
|
| - | 249 | function Twist(bmp: TDIB; Amount: byte): Boolean; |
|
| - | 250 | function FishEye(bmp: TDIB): Boolean; |
|
| - | 251 | function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean; |
|
| - | 252 | procedure Lightness(Amount: Integer); |
|
| - | 253 | procedure Saturation(Amount: Integer); |
|
| - | 254 | procedure Contrast(Amount: Integer); |
|
| - | 255 | procedure AddRGB(aR, aG, aB: Byte); |
|
| - | 256 | function Filter(Dest: TDIB; Filter: TFilter): Boolean; |
|
| - | 257 | procedure Sharpen(Amount: Integer); |
|
| - | 258 | function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 259 | function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean; |
|
| - | 260 | procedure SplitBlur(Amount: Integer); |
|
| - | 261 | procedure GaussianBlur(Bmp: TDIB; Amount: Integer); |
|
| - | 262 | { End of New Special Effect } |
|
| - | 263 | { |
|
| - | 264 | New effect for TDIB |
|
| - | 265 | with Some Effects like AntiAlias, Contrast, |
|
| - | 266 | Lightness, Saturation, GaussianBlur, Mosaic, |
|
| - | 267 | Twist, Splitlight, Trace, Emboss, etc. |
|
| - | 268 | Works with 24bit color DIBs. |
|
| - | 269 | ||
| - | 270 | This component is based on TProEffectImage component version 1.0 by |
|
| - | 271 | Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com) |
|
| - | 272 | ||
| - | 273 | and modified by (c) 2004 Jaro Benes |
|
| - | 274 | for DelphiX use. |
|
| - | 275 | ||
| - | 276 | Demo was modified into DXForm with function like original |
|
| - | 277 | ||
| - | 278 | DISCLAIMER |
|
| - | 279 | This component is provided AS-IS without any warranty of any kind, either express or |
|
| - | 280 | implied. This component is freeware and can be used in any software product. |
|
| - | 281 | } |
|
| - | 282 | procedure DoInvert; |
|
| - | 283 | procedure DoAddColorNoise(Amount: Integer); |
|
| - | 284 | procedure DoAddMonoNoise(Amount: Integer); |
|
| - | 285 | procedure DoAntiAlias; |
|
| - | 286 | procedure DoContrast(Amount: Integer); |
|
| - | 287 | procedure DoFishEye(Amount: Integer); |
|
| - | 288 | procedure DoGrayScale; |
|
| - | 289 | procedure DoLightness(Amount: Integer); |
|
| - | 290 | procedure DoDarkness(Amount: Integer); |
|
| - | 291 | procedure DoSaturation(Amount: Integer); |
|
| - | 292 | procedure DoSplitBlur(Amount: Integer); |
|
| - | 293 | procedure DoGaussianBlur(Amount: Integer); |
|
| - | 294 | procedure DoMosaic(Size: Integer); |
|
| - | 295 | procedure DoTwist(Amount: Integer); |
|
| - | 296 | procedure DoSplitlight(Amount: Integer); |
|
| - | 297 | procedure DoTile(Amount: Integer); |
|
| - | 298 | procedure DoSpotLight(Amount: Integer; Spot: TRect); |
|
| - | 299 | procedure DoTrace(Amount: Integer); |
|
| - | 300 | procedure DoEmboss; |
|
| - | 301 | procedure DoSolorize(Amount: Integer); |
|
| - | 302 | procedure DoPosterize(Amount: Integer); |
|
| - | 303 | procedure DoBrightness(Amount: Integer); |
|
| - | 304 | procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample); |
|
| - | 305 | {rotate} |
|
| - | 306 | procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended); |
|
| - | 307 | procedure DoColorize(ForeColor, BackColor: TColor); |
|
| - | 308 | {Simple explosion spoke effect} |
|
| - | 309 | procedure DoNovaEffect(sr, sg, sb, cx, cy, radius, |
|
| - | 310 | nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent); |
|
| - | 311 | ||
| - | 312 | {Simple Mandelbrot-set drawing} |
|
| - | 313 | procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double); |
|
| - | 314 | ||
| - | 315 | {Sephia effect} |
|
| - | 316 | procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF}); |
|
| - | 317 | ||
| - | 318 | {Simple blend pixel} |
|
| - | 319 | procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 320 | {Line in polar system} |
|
| - | 321 | procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended; |
|
| - | 322 | Color: cardinal); |
|
| - | 323 | ||
| - | 324 | {special version Dark/Light procedure in percent} |
|
| - | 325 | procedure Darker(Percent: Integer); |
|
| - | 326 | procedure Lighter(Percent: Integer); |
|
| - | 327 | ||
| - | 328 | {Simple graphical crypt} |
|
| - | 329 | procedure EncryptDecrypt(const Key: Integer); |
|
| - | 330 | ||
| - | 331 | { Standalone DXFusion } |
|
| - | 332 | {--- c o n F u s i o n ---} |
|
| - | 333 | {By Joakim Back, www.back.mine.nu} |
|
| - | 334 | {Huge thanks to Ilkka Tuomioja for helping out with the project.} |
|
| - | 335 | ||
| - | 336 | { |
|
| - | 337 | modified by (c) 2005 Jaro Benes for DelphiX use. |
|
| - | 338 | } |
|
| - | 339 | ||
| - | 340 | procedure CreateDIBFromBitmap(const Bitmap: TBitmap); |
|
| - | 341 | {Drawing Methods.} |
|
| - | 342 | procedure DrawOn(Dest: TRect; DestCanvas: TCanvas; |
|
| - | 343 | Xsrc, Ysrc: Integer); |
|
| - | 344 | procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX, |
|
| - | 345 | SourceY: Integer); |
|
| - | 346 | procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 347 | SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF} |
|
| - | 348 | procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer; |
|
| - | 349 | FilterMode: TFilterMode); |
|
| - | 350 | procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer; |
|
| - | 351 | Alpha: Byte); |
|
| - | 352 | procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height, |
|
| - | 353 | Frame: Integer); |
|
| - | 354 | procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF}; |
|
| - | 355 | Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF}); |
|
| - | 356 | procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 357 | SourceX, SourceY: Integer; const Color: TColor; |
|
| - | 358 | FilterMode: TFilterMode); |
|
| - | 359 | procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 360 | SourceX, SourceY: Integer; const Color: TColor); |
|
| - | 361 | procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
|
| - | 362 | SourceY: Integer; const Color: TColor); |
|
| - | 363 | procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
|
| - | 364 | SourceY, Alpha: Integer; const Color: TColor); |
|
| - | 365 | procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width, |
|
| - | 366 | Height, SourceX, SourceY: Integer); |
|
| - | 367 | procedure DrawAntialias(SrcDIB: TDIB); |
|
| - | 368 | procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting); |
|
| - | 369 | procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX, |
|
| - | 370 | SourceY: Integer; const TransColor, ForeColor, BackColor: TColor); |
|
| - | 371 | {One-color Filters.} |
|
| - | 372 | procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor; |
|
| - | 373 | FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 374 | procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor; |
|
| - | 375 | FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 376 | { Lightsource. } |
|
| - | 377 | procedure InitLight(Count, Detail: Integer); |
|
| - | 378 | procedure DrawLights(FLight: TLightArray; AmbientLight: TColor); |
|
| - | 379 | // |
|
| - | 380 | // effect for special purpose |
|
| - | 381 | // |
|
| - | 382 | procedure FadeOut(DIB2: TDIB; Step: Byte); |
|
| - | 383 | procedure DoZoom(DIB2: TDIB; ZoomRatio: Real); |
|
| - | 384 | procedure DoBlur(DIB2: TDIB); |
|
| - | 385 | procedure FadeIn(DIB2: TDIB; Step: Byte); |
|
| - | 386 | procedure FillDIB8(Color: Byte); |
|
| - | 387 | procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer); |
|
| - | 388 | procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real); |
|
| - | 389 | function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean; |
|
| - | 390 | // lines |
|
| - | 391 | procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF} |
|
| - | 392 | function GetColorBetween(StartColor, EndColor: TColor; Pointvalue, |
|
| - | 393 | FromPoint, ToPoint: Extended): TColor; |
|
| - | 394 | procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle; |
|
| - | 395 | iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; |
|
| - | 396 | iRadius: WORD); |
|
| - | 397 | // standard property |
|
| 158 | property BitCount: Integer read FBitCount write SetBitCount; |
398 | property BitCount: Integer read FBitCount write SetBitCount; |
| 159 | property BitmapInfo: PBitmapInfo read GetBitmapInfo; |
399 | property BitmapInfo: PBitmapInfo read GetBitmapInfo; |
| 160 | property BitmapInfoSize: Integer read GetBitmapInfoSize; |
400 | property BitmapInfoSize: Integer read GetBitmapInfoSize; |
| 161 | property Canvas: TCanvas read GetCanvas; |
401 | property Canvas: TCanvas read GetCanvas; |
| 162 | property Handle: THandle read GetHandle; |
402 | property Handle: THandle read GetHandle; |
| Line 172... | Line 412... | ||
| 172 | property Size: Integer read FSize; |
412 | property Size: Integer read FSize; |
| 173 | property TopPBits: Pointer read GetTopPBits; |
413 | property TopPBits: Pointer read GetTopPBits; |
| 174 | property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly; |
414 | property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly; |
| 175 | property Width: Integer read FWidth write SetWidth; |
415 | property Width: Integer read FWidth write SetWidth; |
| 176 | property WidthBytes: Integer read FWidthBytes; |
416 | property WidthBytes: Integer read FWidthBytes; |
| - | 417 | property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel; |
|
| - | 418 | property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel; |
|
| - | 419 | function CreateBitmapFromDIB: TBitmap; |
|
| - | 420 | procedure Fill(aColor: TColor); |
|
| - | 421 | property ClientRect: TRect read GetClientRect; |
|
| 177 | end; |
422 | end; |
| 178 | 423 | ||
| - | 424 | { TDIBitmap } |
|
| - | 425 | ||
| 179 | TDIBitmap = class(TDIB) end; |
426 | TDIBitmap = class(TDIB) end; |
| 180 | 427 | ||
| 181 | { TCustomDXDIB } |
428 | { TCustomDXDIB } |
| 182 | 429 | ||
| 183 | TCustomDXDIB = class(TComponent) |
430 | TCustomDXDIB = class(TComponent) |
| Line 233... | Line 480... | ||
| 233 | 480 | ||
| 234 | { TDXPaintBox } |
481 | { TDXPaintBox } |
| 235 | 482 | ||
| 236 | TDXPaintBox = class(TCustomDXPaintBox) |
483 | TDXPaintBox = class(TCustomDXPaintBox) |
| 237 | published |
484 | published |
| 238 | {$IFDEF DelphiX_Spt4}property Anchors;{$ENDIF} |
485 | {$IFDEF VER4UP}property Anchors; {$ENDIF} |
| 239 | property AutoStretch; |
486 | property AutoStretch; |
| 240 | property Center; |
487 | property Center; |
| 241 | {$IFDEF DelphiX_Spt4}property Constraints;{$ENDIF} |
488 | {$IFDEF VER4UP}property Constraints; {$ENDIF} |
| 242 | property DIB; |
489 | property DIB; |
| 243 | property KeepAspect; |
490 | property KeepAspect; |
| 244 | property Stretch; |
491 | property Stretch; |
| 245 | property ViewWidth; |
492 | property ViewWidth; |
| 246 | property ViewHeight; |
493 | property ViewHeight; |
| Line 259... | Line 506... | ||
| 259 | property OnDragOver; |
506 | property OnDragOver; |
| 260 | property OnEndDrag; |
507 | property OnEndDrag; |
| 261 | property OnMouseDown; |
508 | property OnMouseDown; |
| 262 | property OnMouseMove; |
509 | property OnMouseMove; |
| 263 | property OnMouseUp; |
510 | property OnMouseUp; |
| - | 511 | {$IFDEF VER9UP}property OnMouseWheel; {$ENDIF} |
|
| - | 512 | {$IFDEF VER9UP}property OnResize; {$ENDIF} |
|
| - | 513 | {$IFDEF VER9UP}property OnCanResize; {$ENDIF} |
|
| - | 514 | {$IFDEF VER9UP}property OnContextPopup; {$ENDIF} |
|
| 264 | property OnStartDrag; |
515 | property OnStartDrag; |
| 265 | end; |
516 | end; |
| 266 | 517 | ||
| - | 518 | const |
|
| - | 519 | DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2); |
|
| - | 520 | ||
| 267 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
521 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
| 268 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
522 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
| 269 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; |
523 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF} |
| 270 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); |
524 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF} |
| 271 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
525 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| 272 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
526 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| 273 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
527 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
| 274 | 528 | ||
| 275 | function GreyscaleColorTable: TRGBQuads; |
529 | function GreyscaleColorTable: TRGBQuads; |
| 276 | 530 | ||
| 277 | function RGBQuad(R, G, B: Byte): TRGBQuad; |
531 | function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
| 278 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; |
532 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
| 279 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
533 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF} |
| 280 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
534 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF} |
| 281 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
535 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF} |
| - | 536 | ||
| - | 537 | function PosValue(Value: Integer): Integer; |
|
| - | 538 | ||
| - | 539 | type |
|
| - | 540 | TOC = 0..511; |
|
| - | 541 | function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
|
| - | 542 | function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
|
| - | 543 | ||
| - | 544 | { Added Constants for TFilter Type } |
|
| - | 545 | const |
|
| - | 546 | EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1)); |
|
| - | 547 | StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100)); |
|
| - | 548 | Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100)); |
|
| - | 549 | LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40)); |
|
| - | 550 | GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100)); |
|
| - | 551 | SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2)); |
|
| - | 552 | { End of constants } |
|
| - | 553 | ||
| - | 554 | { Added Constants for DXFusion Type } |
|
| - | 555 | const |
|
| - | 556 | { 3x3 Matrix Presets. } |
|
| - | 557 | msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6); |
|
| - | 558 | msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8); |
|
| - | 559 | msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16); |
|
| - | 560 | msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7); |
|
| - | 561 | msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1); |
|
| - | 562 | ||
| - | 563 | {Proportionaly scale of size, for recountin image sizes} |
|
| - | 564 | function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 565 | ||
| - | 566 | procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF} |
|
| - | 567 | procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF} |
|
| 282 | 568 | ||
| 283 | implementation |
569 | implementation |
| 284 | 570 | ||
| 285 | uses DXConsts; |
571 | uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg; |
| 286 | 572 | ||
| - | 573 | function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; |
|
| - | 574 | var |
|
| - | 575 | XScale, YScale: Single; |
|
| - | 576 | begin |
|
| - | 577 | XScale := 1; |
|
| - | 578 | YScale := 1; |
|
| - | 579 | if TargetWidth < SourceWidth then |
|
| - | 580 | XScale := TargetWidth / SourceWidth; |
|
| - | 581 | if TargetHeight < SourceHeight then |
|
| - | 582 | YScale := TargetHeight / SourceHeight; |
|
| - | 583 | Result := XScale; |
|
| - | 584 | if YScale < Result then |
|
| - | 585 | Result := YScale; |
|
| - | 586 | end; |
|
| - | 587 | ||
| - | 588 | {$IFNDEF VER4UP} |
|
| 287 | function Max(B1, B2: Integer): Integer; |
589 | function Max(B1, B2: Integer): Integer; |
| 288 | begin |
590 | begin |
| 289 | if B1>=B2 then Result := B1 else Result := B2; |
591 | if B1 >= B2 then Result := B1 else Result := B2; |
| - | 592 | end; |
|
| - | 593 | ||
| - | 594 | function Min(B1, B2: Integer): Integer; |
|
| - | 595 | begin |
|
| - | 596 | if B1 <= B2 then Result := B1 else Result := B2; |
|
| - | 597 | end; |
|
| - | 598 | {$ENDIF} |
|
| - | 599 | ||
| - | 600 | function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
|
| - | 601 | begin |
|
| - | 602 | Result := sin(((c * 360) / 511) * Pi / 180); |
|
| - | 603 | end; |
|
| - | 604 | ||
| - | 605 | function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF} |
|
| - | 606 | begin |
|
| - | 607 | Result := cos(((c * 360) / 511) * Pi / 180); |
|
| 290 | end; |
608 | end; |
| 291 | 609 | ||
| 292 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
610 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
| 293 | begin |
611 | begin |
| 294 | Result.RBitMask := ((1 shl RBitCount)-1) shl (GBitCount+BBitCount); |
612 | Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount); |
| 295 | Result.GBitMask := ((1 shl GBitCount)-1) shl (BBitCount); |
613 | Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount); |
| 296 | Result.BBitMask := (1 shl BBitCount)-1; |
614 | Result.BBitMask := (1 shl BBitCount) - 1; |
| 297 | Result.RBitCount := RBitCount; |
615 | Result.RBitCount := RBitCount; |
| 298 | Result.GBitCount := GBitCount; |
616 | Result.GBitCount := GBitCount; |
| 299 | Result.BBitCount := BBitCount; |
617 | Result.BBitCount := BBitCount; |
| 300 | Result.RBitCount2 := 8-RBitCount; |
618 | Result.RBitCount2 := 8 - RBitCount; |
| 301 | Result.GBitCount2 := 8-GBitCount; |
619 | Result.GBitCount2 := 8 - GBitCount; |
| 302 | Result.BBitCount2 := 8-BBitCount; |
620 | Result.BBitCount2 := 8 - BBitCount; |
| 303 | Result.RShift := (GBitCount+BBitCount)-(8-RBitCount); |
621 | Result.RShift := (GBitCount + BBitCount) - (8 - RBitCount); |
| 304 | Result.GShift := BBitCount-(8-GBitCount); |
622 | Result.GShift := BBitCount - (8 - GBitCount); |
| 305 | Result.BShift := 8-BBitCount; |
623 | Result.BShift := 8 - BBitCount; |
| 306 | end; |
624 | end; |
| 307 | 625 | ||
| 308 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
626 | function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
| - | 627 | var |
|
| - | 628 | i: Integer; |
|
| - | 629 | begin |
|
| - | 630 | i := 0; |
|
| - | 631 | while (i < 31) and (((1 shl i) and b) = 0) do Inc(i); |
|
| 309 | 632 | ||
| 310 | function GetBitCount(b: Integer): Integer; |
- | |
| 311 | var |
633 | Result := 0; |
| 312 | i: Integer; |
634 | while ((1 shl i) and b) <> 0 do |
| 313 | begin |
635 | begin |
| 314 | i := 0; |
- | |
| 315 | while (i<31) and (((1 shl i) and b)=0) do Inc(i); |
- | |
| 316 | - | ||
| 317 | Result := 0; |
- | |
| 318 | while ((1 shl i) and b)<>0 do |
- | |
| 319 | begin |
- | |
| 320 | Inc(i); |
636 | Inc(i); |
| 321 | Inc(Result); |
637 | Inc(Result); |
| 322 | end; |
- | |
| 323 | end; |
638 | end; |
| - | 639 | end; |
|
| 324 | 640 | ||
| - | 641 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
|
| 325 | begin |
642 | begin |
| 326 | Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask), |
643 | Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask), |
| 327 | GetBitCount(BBitMask)); |
644 | GetBitCount(BBitMask)); |
| 328 | end; |
645 | end; |
| 329 | 646 | ||
| Line 350... | Line 667... | ||
| 350 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
667 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| 351 | begin |
668 | begin |
| 352 | with PixelFormat do |
669 | with PixelFormat do |
| 353 | begin |
670 | begin |
| 354 | Result := (Color and RBitMask) shr RShift; |
671 | Result := (Color and RBitMask) shr RShift; |
| 355 | Result := Result or (Result shr RBitCount); |
672 | Result := Result or (Result shr RBitCount2); |
| 356 | end; |
673 | end; |
| 357 | end; |
674 | end; |
| 358 | 675 | ||
| 359 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
676 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| 360 | begin |
677 | begin |
| 361 | with PixelFormat do |
678 | with PixelFormat do |
| 362 | begin |
679 | begin |
| 363 | Result := (Color and GBitMask) shr GShift; |
680 | Result := (Color and GBitMask) shr GShift; |
| 364 | Result := Result or (Result shr GBitCount); |
681 | Result := Result or (Result shr GBitCount2); |
| 365 | end; |
682 | end; |
| 366 | end; |
683 | end; |
| 367 | 684 | ||
| 368 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
685 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
| 369 | begin |
686 | begin |
| 370 | with PixelFormat do |
687 | with PixelFormat do |
| 371 | begin |
688 | begin |
| 372 | Result := (Color and BBitMask) shl BShift; |
689 | Result := (Color and BBitMask) shl BShift; |
| 373 | Result := Result or (Result shr BBitCount); |
690 | Result := Result or (Result shr BBitCount2); |
| 374 | end; |
691 | end; |
| 375 | end; |
692 | end; |
| 376 | 693 | ||
| 377 | function GreyscaleColorTable: TRGBQuads; |
694 | function GreyscaleColorTable: TRGBQuads; |
| 378 | var |
695 | var |
| 379 | i: Integer; |
696 | i: Integer; |
| 380 | begin |
697 | begin |
| 381 | for i:=0 to 255 do |
698 | for i := 0 to 255 do |
| 382 | with Result[i] do |
699 | with Result[i] do |
| 383 | begin |
700 | begin |
| 384 | rgbRed := i; |
701 | rgbRed := i; |
| 385 | rgbGreen := i; |
702 | rgbGreen := i; |
| 386 | rgbBlue := i; |
703 | rgbBlue := i; |
| Line 413... | Line 730... | ||
| 413 | 730 | ||
| 414 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
731 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
| 415 | var |
732 | var |
| 416 | i: Integer; |
733 | i: Integer; |
| 417 | begin |
734 | begin |
| 418 | for i:=0 to 255 do |
735 | for i := 0 to 255 do |
| 419 | Result[i] := PaletteEntryToRGBQuad(Entries[i]); |
736 | Result[i] := PaletteEntryToRGBQuad(Entries[i]); |
| 420 | end; |
737 | end; |
| 421 | 738 | ||
| 422 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
739 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
| 423 | begin |
740 | begin |
| Line 433... | Line 750... | ||
| 433 | 750 | ||
| 434 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
751 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
| 435 | var |
752 | var |
| 436 | i: Integer; |
753 | i: Integer; |
| 437 | begin |
754 | begin |
| 438 | for i:=0 to 255 do |
755 | for i := 0 to 255 do |
| 439 | Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]); |
756 | Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]); |
| 440 | end; |
757 | end; |
| 441 | 758 | ||
| 442 | { TDIBSharedImage } |
759 | { TDIBSharedImage } |
| 443 | 760 | ||
| Line 445... | Line 762... | ||
| 445 | PLocalDIBPixelFormat = ^TLocalDIBPixelFormat; |
762 | PLocalDIBPixelFormat = ^TLocalDIBPixelFormat; |
| 446 | TLocalDIBPixelFormat = packed record |
763 | TLocalDIBPixelFormat = packed record |
| 447 | RBitMask, GBitMask, BBitMask: DWORD; |
764 | RBitMask, GBitMask, BBitMask: DWORD; |
| 448 | end; |
765 | end; |
| 449 | 766 | ||
| - | 767 | { TPaletteItem } |
|
| - | 768 | ||
| 450 | TPaletteItem = class(TCollectionItem) |
769 | TPaletteItem = class(TCollectionItem) |
| 451 | private |
770 | private |
| 452 | ID: Integer; |
771 | ID: Integer; |
| 453 | Palette: HPalette; |
772 | Palette: HPalette; |
| 454 | RefCount: Integer; |
773 | RefCount: Integer; |
| 455 | ColorTable: TRGBQuads; |
774 | ColorTable: TRGBQuads; |
| 456 | ColorTableCount: Integer; |
775 | ColorTableCount: Integer; |
| 457 | destructor Destroy; override; |
776 | destructor Destroy; override; |
| 458 | procedure AddRef; |
777 | procedure AddRef; |
| 459 | procedure Release; |
778 | procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF} |
| 460 | end; |
779 | end; |
| 461 | 780 | ||
| - | 781 | { TPaletteManager } |
|
| - | 782 | ||
| 462 | TPaletteManager = class |
783 | TPaletteManager = class |
| 463 | private |
784 | private |
| 464 | FList: TCollection; |
785 | FList: TCollection; |
| 465 | constructor Create; |
786 | constructor Create; |
| 466 | destructor Destroy; override; |
787 | destructor Destroy; override; |
| 467 | function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
788 | function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
| 468 | procedure DeletePalette(var Palette: HPalette); |
789 | procedure DeletePalette(var Palette: HPalette); |
| 469 | end; |
790 | end; |
| 470 | 791 | ||
| - | 792 | { TPaletteItem } |
|
| - | 793 | ||
| 471 | destructor TPaletteItem.Destroy; |
794 | destructor TPaletteItem.Destroy; |
| 472 | begin |
795 | begin |
| 473 | DeleteObject(Palette); |
796 | DeleteObject(Palette); |
| 474 | inherited Destroy; |
797 | inherited Destroy; |
| 475 | end; |
798 | end; |
| Line 480... | Line 803... | ||
| 480 | end; |
803 | end; |
| 481 | 804 | ||
| 482 | procedure TPaletteItem.Release; |
805 | procedure TPaletteItem.Release; |
| 483 | begin |
806 | begin |
| 484 | Dec(RefCount); |
807 | Dec(RefCount); |
| 485 | if RefCount<=0 then Free; |
808 | if RefCount <= 0 then Free; |
| 486 | end; |
809 | end; |
| 487 | 810 | ||
| - | 811 | { TPaletteManager } |
|
| - | 812 | ||
| 488 | constructor TPaletteManager.Create; |
813 | constructor TPaletteManager.Create; |
| 489 | begin |
814 | begin |
| 490 | inherited Create; |
815 | inherited Create; |
| 491 | FList := TCollection.Create(TPaletteItem); |
816 | FList := TCollection.Create(TPaletteItem); |
| 492 | end; |
817 | end; |
| Line 509... | Line 834... | ||
| 509 | Item: TPaletteItem; |
834 | Item: TPaletteItem; |
| 510 | LogPalette: TMyLogPalette; |
835 | LogPalette: TMyLogPalette; |
| 511 | begin |
836 | begin |
| 512 | { Hash key making } |
837 | { Hash key making } |
| 513 | ID := ColorTableCount; |
838 | ID := ColorTableCount; |
| 514 | for i:=0 to ColorTableCount-1 do |
839 | for i := 0 to ColorTableCount - 1 do |
| 515 | with ColorTable[i] do |
840 | with ColorTable[i] do |
| 516 | begin |
841 | begin |
| 517 | Inc(ID, rgbRed); |
842 | Inc(ID, rgbRed); |
| 518 | Inc(ID, rgbGreen); |
843 | Inc(ID, rgbGreen); |
| 519 | Inc(ID, rgbBlue); |
844 | Inc(ID, rgbBlue); |
| 520 | end; |
845 | end; |
| 521 | 846 | ||
| 522 | { Does the same palette already exist? } |
847 | { Does the same palette already exist? } |
| 523 | for i:=0 to FList.Count-1 do |
848 | for i := 0 to FList.Count - 1 do |
| 524 | begin |
849 | begin |
| 525 | Item := TPaletteItem(FList.Items[i]); |
850 | Item := TPaletteItem(FList.Items[i]); |
| 526 | if (Item.ID=ID) and (Item.ColorTableCount=ColorTableCount) and |
851 | if (Item.ID = ID) and (Item.ColorTableCount = ColorTableCount) and |
| 527 | CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount*SizeOf(TRGBQuad)) then |
852 | CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount * SizeOf(TRGBQuad)) then |
| 528 | begin |
853 | begin |
| 529 | Item.AddRef; Result := Item.Palette; |
854 | Item.AddRef; Result := Item.Palette; |
| 530 | Exit; |
855 | Exit; |
| 531 | end; |
856 | end; |
| 532 | end; |
857 | end; |
| 533 | 858 | ||
| 534 | { New palette making } |
859 | { New palette making } |
| 535 | Item := TPaletteItem.Create(FList); |
860 | Item := TPaletteItem.Create(FList); |
| 536 | Item.ID := ID; |
861 | Item.ID := ID; |
| 537 | Move(ColorTable, Item.ColorTable, ColorTableCount*SizeOf(TRGBQuad)); |
862 | Move(ColorTable, Item.ColorTable, ColorTableCount * SizeOf(TRGBQuad)); |
| 538 | Item.ColorTableCount := ColorTableCount; |
863 | Item.ColorTableCount := ColorTableCount; |
| 539 | 864 | ||
| 540 | with LogPalette do |
865 | with LogPalette do |
| 541 | begin |
866 | begin |
| 542 | palVersion := $300; |
867 | palVersion := $300; |
| Line 551... | Line 876... | ||
| 551 | procedure TPaletteManager.DeletePalette(var Palette: HPalette); |
876 | procedure TPaletteManager.DeletePalette(var Palette: HPalette); |
| 552 | var |
877 | var |
| 553 | i: Integer; |
878 | i: Integer; |
| 554 | Item: TPaletteItem; |
879 | Item: TPaletteItem; |
| 555 | begin |
880 | begin |
| 556 | if Palette=0 then Exit; |
881 | if Palette = 0 then Exit; |
| 557 | 882 | ||
| 558 | for i:=0 to FList.Count-1 do |
883 | for i := 0 to FList.Count - 1 do |
| 559 | begin |
884 | begin |
| 560 | Item := TPaletteItem(FList.Items[i]); |
885 | Item := TPaletteItem(FList.Items[i]); |
| 561 | if (Item.Palette=Palette) then |
886 | if (Item.Palette = Palette) then |
| 562 | begin |
887 | begin |
| 563 | Palette := 0; |
888 | Palette := 0; |
| 564 | Item.Release; |
889 | Item.Release; |
| 565 | Exit; |
890 | Exit; |
| 566 | end; |
891 | end; |
| Line 570... | Line 895... | ||
| 570 | var |
895 | var |
| 571 | FPaletteManager: TPaletteManager; |
896 | FPaletteManager: TPaletteManager; |
| 572 | 897 | ||
| 573 | function PaletteManager: TPaletteManager; |
898 | function PaletteManager: TPaletteManager; |
| 574 | begin |
899 | begin |
| 575 | if FPaletteManager=nil then |
900 | if FPaletteManager = nil then |
| 576 | FPaletteManager := TPaletteManager.Create; |
901 | FPaletteManager := TPaletteManager.Create; |
| 577 | Result := FPaletteManager; |
902 | Result := FPaletteManager; |
| 578 | end; |
903 | end; |
| 579 | 904 | ||
| - | 905 | { TDIBSharedImage } |
|
| - | 906 | ||
| 580 | constructor TDIBSharedImage.Create; |
907 | constructor TDIBSharedImage.Create; |
| 581 | begin |
908 | begin |
| 582 | inherited Create; |
909 | inherited Create; |
| 583 | FMemoryImage := True; |
910 | FMemoryImage := True; |
| 584 | SetColorTable(GreyscaleColorTable); |
911 | SetColorTable(GreyscaleColorTable); |
| Line 590... | Line 917... | ||
| 590 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
917 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
| 591 | var |
918 | var |
| 592 | InfoOfs: Integer; |
919 | InfoOfs: Integer; |
| 593 | UsePixelFormat: Boolean; |
920 | UsePixelFormat: Boolean; |
| 594 | begin |
921 | begin |
| - | 922 | {$IFNDEF D17UP} |
|
| - | 923 | {self recreation is not allowed here} |
|
| 595 | Create; |
924 | Create; |
| 596 | 925 | {$ENDIF} |
|
| 597 | { Pixel format check } |
926 | { Pixel format check } |
| 598 | case ABitCount of |
927 | case ABitCount of |
| 599 | 1 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
928 | 1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 600 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
929 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 601 | 4 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
930 | 4: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 602 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
931 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 603 | 8 : if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
932 | 8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 604 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
933 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| - | 934 | 16: |
|
| 605 | 16: begin |
935 | begin |
| 606 | if not (((PixelFormat.RBitMask=$7C00) and (PixelFormat.GBitMask=$03E0) and (PixelFormat.BBitMask=$001F)) or |
936 | if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or |
| 607 | ((PixelFormat.RBitMask=$F800) and (PixelFormat.GBitMask=$07E0) and (PixelFormat.BBitMask=$001F))) then |
937 | ((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then |
| 608 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
938 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 609 | end; |
939 | end; |
| - | 940 | 24: |
|
| 610 | 24: begin |
941 | begin |
| 611 | if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
942 | if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 612 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
943 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 613 | end; |
944 | end; |
| - | 945 | 32: |
|
| 614 | 32: begin |
946 | begin |
| 615 | if not ((PixelFormat.RBitMask=$FF0000) and (PixelFormat.GBitMask=$00FF00) and (PixelFormat.BBitMask=$0000FF)) then |
947 | if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
| 616 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
948 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
| 617 | end; |
949 | end; |
| 618 | else |
950 | else |
| 619 | raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]); |
951 | raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]); |
| 620 | end; |
952 | end; |
| 621 | 953 | ||
| 622 | FBitCount := ABitCount; |
954 | FBitCount := ABitCount; |
| 623 | FHeight := AHeight; |
955 | FHeight := AHeight; |
| 624 | FWidth := AWidth; |
956 | FWidth := AWidth; |
| 625 | FWidthBytes := (((AWidth*ABitCount)+31) shr 5) * 4; |
957 | FWidthBytes := (((AWidth * ABitCount) + 31) shr 5) * 4; |
| 626 | FNextLine := -FWidthBytes; |
958 | FNextLine := -FWidthBytes; |
| 627 | FSize := FWidthBytes*FHeight; |
959 | FSize := FWidthBytes * FHeight; |
| 628 | UsePixelFormat := ABitCount in [16, 32]; |
960 | UsePixelFormat := ABitCount in [16, 32]; |
| 629 | 961 | ||
| 630 | FPixelFormat := PixelFormat; |
962 | FPixelFormat := PixelFormat; |
| 631 | 963 | ||
| 632 | FPaletteCount := 0; |
964 | FPaletteCount := 0; |
| 633 | if FBitCount<=8 then |
965 | if FBitCount <= 8 then |
| 634 | FPaletteCount := 1 shl FBitCount; |
966 | FPaletteCount := 1 shl FBitCount; |
| 635 | 967 | ||
| 636 | FBitmapInfoSize := SizeOf(TBitmapInfoHeader); |
968 | FBitmapInfoSize := SizeOf(TBitmapInfoHeader); |
| 637 | if UsePixelFormat then |
969 | if UsePixelFormat then |
| 638 | Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat)); |
970 | Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat)); |
| 639 | Inc(FBitmapInfoSize, SizeOf(TRGBQuad)*FPaletteCount); |
971 | Inc(FBitmapInfoSize, SizeOf(TRGBQuad) * FPaletteCount); |
| 640 | 972 | ||
| 641 | GetMem(FBitmapInfo, FBitmapInfoSize); |
973 | GetMem(FBitmapInfo, FBitmapInfoSize); |
| 642 | FillChar(FBitmapInfo^, FBitmapInfoSize, 0); |
974 | FillChar(FBitmapInfo^, FBitmapInfoSize, 0); |
| 643 | 975 | ||
| 644 | { BitmapInfo setting. } |
976 | { BitmapInfo setting. } |
| Line 651... | Line 983... | ||
| 651 | biBitCount := FBitCount; |
983 | biBitCount := FBitCount; |
| 652 | if UsePixelFormat then |
984 | if UsePixelFormat then |
| 653 | biCompression := BI_BITFIELDS |
985 | biCompression := BI_BITFIELDS |
| 654 | else |
986 | else |
| 655 | begin |
987 | begin |
| 656 | if (FBitCount=4) and (Compressed) then |
988 | if (FBitCount = 4) and (Compressed) then |
| 657 | biCompression := BI_RLE4 |
989 | biCompression := BI_RLE4 |
| 658 | else if (FBitCount=8) and (Compressed) then |
990 | else if (FBitCount = 8) and (Compressed) then |
| 659 | biCompression := BI_RLE8 |
991 | biCompression := BI_RLE8 |
| 660 | else |
992 | else |
| 661 | biCompression := BI_RGB; |
993 | biCompression := BI_RGB; |
| 662 | end; |
994 | end; |
| 663 | biSizeImage := FSize; |
995 | biSizeImage := FSize; |
| Line 668... | Line 1000... | ||
| 668 | end; |
1000 | end; |
| 669 | InfoOfs := SizeOf(TBitmapInfoHeader); |
1001 | InfoOfs := SizeOf(TBitmapInfoHeader); |
| 670 | 1002 | ||
| 671 | if UsePixelFormat then |
1003 | if UsePixelFormat then |
| 672 | begin |
1004 | begin |
| 673 | with PLocalDIBPixelFormat(Integer(FBitmapInfo)+InfoOfs)^ do |
1005 | with PLocalDIBPixelFormat(Integer(FBitmapInfo) + InfoOfs)^ do |
| 674 | begin |
1006 | begin |
| 675 | RBitMask := PixelFormat.RBitMask; |
1007 | RBitMask := PixelFormat.RBitMask; |
| 676 | GBitMask := PixelFormat.GBitMask; |
1008 | GBitMask := PixelFormat.GBitMask; |
| 677 | BBitMask := PixelFormat.BBitMask; |
1009 | BBitMask := PixelFormat.BBitMask; |
| 678 | end; |
1010 | end; |
| Line 681... | Line 1013... | ||
| 681 | end; |
1013 | end; |
| 682 | 1014 | ||
| 683 | FColorTablePos := InfoOfs; |
1015 | FColorTablePos := InfoOfs; |
| 684 | 1016 | ||
| 685 | FColorTable := ColorTable; |
1017 | FColorTable := ColorTable; |
| 686 | Move(FColorTable, Pointer(Integer(FBitmapInfo)+FColorTablePos)^, SizeOf(TRGBQuad)*FPaletteCount); |
1018 | Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount); |
| 687 | 1019 | ||
| 688 | FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8]; |
1020 | FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8]; |
| 689 | FMemoryImage := MemoryImage or FCompressed; |
1021 | FMemoryImage := MemoryImage or FCompressed; |
| 690 | 1022 | ||
| 691 | { DIB making. } |
1023 | { DIB making. } |
| 692 | if not Compressed then |
1024 | if not Compressed then |
| 693 | begin |
1025 | begin |
| 694 | if MemoryImage then |
1026 | if MemoryImage then |
| 695 | begin |
1027 | begin |
| 696 | FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize)); |
1028 | FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize)); |
| 697 | if FPBits=nil then |
1029 | if FPBits = nil then |
| 698 | OutOfMemoryError; |
1030 | OutOfMemoryError; |
| - | 1031 | end |
|
| 699 | end else |
1032 | else |
| 700 | begin |
1033 | begin |
| 701 | FDC := CreateCompatibleDC(0); |
1034 | FDC := CreateCompatibleDC(0); |
| 702 | 1035 | ||
| 703 | FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0); |
1036 | FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0); |
| 704 | if FHandle=0 then |
1037 | if FHandle = 0 then |
| 705 | raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']); |
1038 | raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']); |
| 706 | 1039 | ||
| 707 | FOldHandle := SelectObject(FDC, FHandle); |
1040 | FOldHandle := SelectObject(FDC, FHandle); |
| 708 | end; |
1041 | end; |
| 709 | end; |
1042 | end; |
| 710 | 1043 | ||
| 711 | FTopPBits := Pointer(Integer(FPBits)+(FHeight-1)*FWidthBytes); |
1044 | FTopPBits := Pointer(Integer(FPBits) + (FHeight - 1) * FWidthBytes); |
| 712 | end; |
1045 | end; |
| 713 | 1046 | ||
| 714 | procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
1047 | procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
| 715 | begin |
1048 | begin |
| - | 1049 | if Source = nil then Exit; //no source |
|
| - | 1050 | ||
| 716 | if Source.FSize=0 then |
1051 | if Source.FSize = 0 then |
| 717 | begin |
1052 | begin |
| - | 1053 | {$IFNDEF D17UP} |
|
| - | 1054 | {self recreation is not allowed here} |
|
| 718 | Create; |
1055 | Create; |
| - | 1056 | {$ENDIF} |
|
| 719 | FMemoryImage := MemoryImage; |
1057 | FMemoryImage := MemoryImage; |
| - | 1058 | end |
|
| 720 | end else |
1059 | else |
| 721 | begin |
1060 | begin |
| 722 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
1061 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| 723 | Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed); |
1062 | Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed); |
| 724 | if FCompressed then |
1063 | if FCompressed then |
| 725 | begin |
1064 | begin |
| 726 | FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage; |
1065 | FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage; |
| 727 | GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage); |
1066 | GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage); |
| 728 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
1067 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
| - | 1068 | end |
|
| 729 | end else |
1069 | else |
| 730 | begin |
1070 | begin |
| 731 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
1071 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
| 732 | end; |
1072 | end; |
| 733 | end; |
1073 | end; |
| 734 | end; |
1074 | end; |
| Line 739... | Line 1079... | ||
| 739 | var |
1079 | var |
| 740 | Size: Integer; |
1080 | Size: Integer; |
| 741 | 1081 | ||
| 742 | function AllocByte: PByte; |
1082 | function AllocByte: PByte; |
| 743 | begin |
1083 | begin |
| 744 | if Size mod 4096=0 then |
1084 | if Size mod 4096 = 0 then |
| 745 | ReAllocMem(FPBits, Size+4095); |
1085 | ReAllocMem(FPBits, Size + 4095); |
| 746 | Result := Pointer(Integer(FPBits)+Size); |
1086 | Result := Pointer(Integer(FPBits) + Size); |
| 747 | Inc(Size); |
1087 | Inc(Size); |
| 748 | end; |
1088 | end; |
| 749 | 1089 | ||
| 750 | var |
1090 | var |
| 751 | B1, B2, C: Byte; |
1091 | B1, B2, C: Byte; |
| Line 753... | Line 1093... | ||
| 753 | Src: PByte; |
1093 | Src: PByte; |
| 754 | X, Y: Integer; |
1094 | X, Y: Integer; |
| 755 | 1095 | ||
| 756 | function GetPixel(x: Integer): Integer; |
1096 | function GetPixel(x: Integer): Integer; |
| 757 | begin |
1097 | begin |
| 758 | if X and 1=0 then |
1098 | if X and 1 = 0 then |
| 759 | Result := PArrayByte(Src)[X shr 1] shr 4 |
1099 | Result := PArrayByte(Src)[X shr 1] shr 4 |
| 760 | else |
1100 | else |
| 761 | Result := PArrayByte(Src)[X shr 1] and $0F; |
1101 | Result := PArrayByte(Src)[X shr 1] and $0F; |
| 762 | end; |
1102 | end; |
| 763 | 1103 | ||
| 764 | begin |
1104 | begin |
| 765 | Size := 0; |
1105 | Size := 0; |
| 766 | 1106 | ||
| 767 | for y:=0 to Source.FHeight-1 do |
1107 | for y := 0 to Source.FHeight - 1 do |
| 768 | begin |
1108 | begin |
| 769 | x := 0; |
1109 | x := 0; |
| 770 | Src := Pointer(Integer(Source.FPBits)+y*FWidthBytes); |
1110 | Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes); |
| 771 | while x<Source.FWidth do |
1111 | while x < Source.FWidth do |
| 772 | begin |
1112 | begin |
| 773 | if (Source.FWidth-x>3) and (GetPixel(x)=GetPixel(x+2)) then |
1113 | if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) then |
| 774 | begin |
1114 | begin |
| 775 | { Encoding mode } |
1115 | { Encoding mode } |
| 776 | B1 := 2; |
1116 | B1 := 2; |
| 777 | B2 := (GetPixel(x) shl 4) or GetPixel(x+1); |
1117 | B2 := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| 778 | 1118 | ||
| 779 | Inc(x, 2); |
1119 | Inc(x, 2); |
| 780 | 1120 | ||
| 781 | C := B2; |
1121 | C := B2; |
| 782 | 1122 | ||
| 783 | while (x<Source.FWidth) and (C and $F=GetPixel(x)) and (B1<255) do |
1123 | while (x < Source.FWidth) and (C and $F = GetPixel(x)) and (B1 < 255) do |
| 784 | begin |
1124 | begin |
| 785 | Inc(B1); |
1125 | Inc(B1); |
| 786 | Inc(x); |
1126 | Inc(x); |
| 787 | C := (C shr 4) or (C shl 4); |
1127 | C := (C shr 4) or (C shl 4); |
| 788 | end; |
1128 | end; |
| 789 | 1129 | ||
| 790 | AllocByte^ := B1; |
1130 | AllocByte^ := B1; |
| 791 | AllocByte^ := B2; |
1131 | AllocByte^ := B2; |
| - | 1132 | end |
|
| 792 | end else |
1133 | else |
| 793 | if (Source.FWidth-x>5) and ((GetPixel(x)<>GetPixel(x+2)) or (GetPixel(x+1)<>GetPixel(x+3))) and |
1134 | if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and |
| 794 | ((GetPixel(x+2)=GetPixel(x+4)) and (GetPixel(x+3)=GetPixel(x+5))) then |
1135 | ((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then |
| 795 | begin |
1136 | begin |
| 796 | { Encoding mode } |
1137 | { Encoding mode } |
| 797 | AllocByte^ := 2; |
1138 | AllocByte^ := 2; |
| 798 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
1139 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| 799 | Inc(x, 2); |
1140 | Inc(x, 2); |
| 800 | end else |
1141 | end |
| 801 | begin |
1142 | else |
| 802 | if (Source.FWidth-x<4) then |
- | |
| 803 | begin |
1143 | begin |
| 804 | { Encoding mode } |
- | |
| 805 | while Source.FWidth-x>=2 do |
1144 | if (Source.FWidth - x < 4) then |
| 806 | begin |
1145 | begin |
| - | 1146 | { Encoding mode } |
|
| - | 1147 | while Source.FWidth - x >= 2 do |
|
| - | 1148 | begin |
|
| 807 | AllocByte^ := 2; |
1149 | AllocByte^ := 2; |
| 808 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
1150 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| 809 | Inc(x, 2); |
1151 | Inc(x, 2); |
| 810 | end; |
1152 | end; |
| 811 | 1153 | ||
| 812 | if Source.FWidth-x=1 then |
1154 | if Source.FWidth - x = 1 then |
| - | 1155 | begin |
|
| - | 1156 | AllocByte^ := 1; |
|
| - | 1157 | AllocByte^ := GetPixel(x) shl 4; |
|
| - | 1158 | Inc(x); |
|
| - | 1159 | end; |
|
| - | 1160 | end |
|
| - | 1161 | else |
|
| 813 | begin |
1162 | begin |
| 814 | AllocByte^ := 1; |
- | |
| 815 | AllocByte^ := GetPixel(x) shl 4; |
- | |
| 816 | Inc(x); |
- | |
| 817 | end; |
- | |
| 818 | end else |
- | |
| 819 | begin |
- | |
| 820 | { Absolute mode } |
1163 | { Absolute mode } |
| 821 | PB1 := Size; AllocByte; |
1164 | PB1 := Size; AllocByte; |
| 822 | PB2 := Size; AllocByte; |
1165 | PB2 := Size; AllocByte; |
| 823 | 1166 | ||
| 824 | B1 := 0; |
1167 | B1 := 0; |
| 825 | B2 := 4; |
1168 | B2 := 4; |
| 826 | 1169 | ||
| 827 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
1170 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| 828 | AllocByte^ := (GetPixel(x+2) shl 4) or GetPixel(x+3); |
1171 | AllocByte^ := (GetPixel(x + 2) shl 4) or GetPixel(x + 3); |
| 829 | 1172 | ||
| 830 | Inc(x, 4); |
1173 | Inc(x, 4); |
| 831 | 1174 | ||
| 832 | while (x+1<Source.FWidth) and (B2<254) do |
1175 | while (x + 1 < Source.FWidth) and (B2 < 254) do |
| 833 | begin |
1176 | begin |
| 834 | if (Source.FWidth-x>3) and (GetPixel(x)=GetPixel(x+2)) and (GetPixel(x+1)=GetPixel(x+3)) then |
1177 | if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) and (GetPixel(x + 1) = GetPixel(x + 3)) then |
| 835 | Break; |
1178 | Break; |
| 836 | 1179 | ||
| 837 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x+1); |
1180 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
| 838 | Inc(B2, 2); |
1181 | Inc(B2, 2); |
| 839 | Inc(x, 2); |
1182 | Inc(x, 2); |
| 840 | end; |
1183 | end; |
| 841 | 1184 | ||
| 842 | PByte(Integer(FPBits)+PB1)^ := B1; |
1185 | PByte(Integer(FPBits) + PB1)^ := B1; |
| 843 | PByte(Integer(FPBits)+PB2)^ := B2; |
1186 | PByte(Integer(FPBits) + PB2)^ := B2; |
| - | 1187 | end; |
|
| 844 | end; |
1188 | end; |
| 845 | end; |
- | |
| 846 | 1189 | ||
| 847 | if Size and 1=1 then AllocByte; |
1190 | if Size and 1 = 1 then AllocByte; |
| 848 | end; |
1191 | end; |
| 849 | 1192 | ||
| 850 | { End of line } |
1193 | { End of line } |
| 851 | AllocByte^ := 0; |
1194 | AllocByte^ := 0; |
| 852 | AllocByte^ := 0; |
1195 | AllocByte^ := 0; |
| Line 864... | Line 1207... | ||
| 864 | var |
1207 | var |
| 865 | Size: Integer; |
1208 | Size: Integer; |
| 866 | 1209 | ||
| 867 | function AllocByte: PByte; |
1210 | function AllocByte: PByte; |
| 868 | begin |
1211 | begin |
| 869 | if Size mod 4096=0 then |
1212 | if Size mod 4096 = 0 then |
| 870 | ReAllocMem(FPBits, Size+4095); |
1213 | ReAllocMem(FPBits, Size + 4095); |
| 871 | Result := Pointer(Integer(FPBits)+Size); |
1214 | Result := Pointer(Integer(FPBits) + Size); |
| 872 | Inc(Size); |
1215 | Inc(Size); |
| 873 | end; |
1216 | end; |
| 874 | 1217 | ||
| 875 | var |
1218 | var |
| 876 | B1, B2: Byte; |
1219 | B1, B2: Byte; |
| Line 878... | Line 1221... | ||
| 878 | Src: PByte; |
1221 | Src: PByte; |
| 879 | X, Y: Integer; |
1222 | X, Y: Integer; |
| 880 | begin |
1223 | begin |
| 881 | Size := 0; |
1224 | Size := 0; |
| 882 | 1225 | ||
| 883 | for y:=0 to Source.FHeight-1 do |
1226 | for y := 0 to Source.FHeight - 1 do |
| 884 | begin |
1227 | begin |
| 885 | x := 0; |
1228 | x := 0; |
| 886 | Src := Pointer(Integer(Source.FPBits)+y*FWidthBytes); |
1229 | Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes); |
| 887 | while x<Source.FWidth do |
1230 | while x < Source.FWidth do |
| 888 | begin |
1231 | begin |
| 889 | if (Source.FWidth-x>2) and (Src^=PByte(Integer(Src)+1)^) then |
1232 | if (Source.FWidth - x > 2) and (Src^ = PByte(Integer(Src) + 1)^) then |
| 890 | begin |
1233 | begin |
| 891 | { Encoding mode } |
1234 | { Encoding mode } |
| 892 | B1 := 2; |
1235 | B1 := 2; |
| 893 | B2 := Src^; |
1236 | B2 := Src^; |
| 894 | 1237 | ||
| 895 | Inc(x, 2); |
1238 | Inc(x, 2); |
| 896 | Inc(Src, 2); |
1239 | Inc(Src, 2); |
| 897 | 1240 | ||
| 898 | while (x<Source.FWidth) and (Src^=B2) and (B1<255) do |
1241 | while (x < Source.FWidth) and (Src^ = B2) and (B1 < 255) do |
| 899 | begin |
1242 | begin |
| 900 | Inc(B1); |
1243 | Inc(B1); |
| 901 | Inc(x); |
1244 | Inc(x); |
| 902 | Inc(Src); |
1245 | Inc(Src); |
| 903 | end; |
1246 | end; |
| 904 | 1247 | ||
| 905 | AllocByte^ := B1; |
1248 | AllocByte^ := B1; |
| 906 | AllocByte^ := B2; |
1249 | AllocByte^ := B2; |
| - | 1250 | end |
|
| 907 | end else |
1251 | else |
| 908 | if (Source.FWidth-x>2) and (Src^<>PByte(Integer(Src)+1)^) and (PByte(Integer(Src)+1)^=PByte(Integer(Src)+2)^) then |
1252 | if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then |
| 909 | begin |
1253 | begin |
| 910 | { Encoding mode } |
1254 | { Encoding mode } |
| 911 | AllocByte^ := 1; |
1255 | AllocByte^ := 1; |
| 912 | AllocByte^ := Src^; Inc(Src); |
1256 | AllocByte^ := Src^; Inc(Src); |
| 913 | Inc(x); |
1257 | Inc(x); |
| 914 | end else |
1258 | end |
| 915 | begin |
1259 | else |
| 916 | if (Source.FWidth-x<4) then |
- | |
| 917 | begin |
1260 | begin |
| 918 | { Encoding mode } |
- | |
| 919 | if Source.FWidth-x=2 then |
1261 | if (Source.FWidth - x < 4) then |
| 920 | begin |
1262 | begin |
| - | 1263 | { Encoding mode } |
|
| - | 1264 | if Source.FWidth - x = 2 then |
|
| - | 1265 | begin |
|
| 921 | AllocByte^ := 1; |
1266 | AllocByte^ := 1; |
| 922 | AllocByte^ := Src^; Inc(Src); |
1267 | AllocByte^ := Src^; Inc(Src); |
| 923 | 1268 | ||
| 924 | AllocByte^ := 1; |
1269 | AllocByte^ := 1; |
| 925 | AllocByte^ := Src^; Inc(Src); |
1270 | AllocByte^ := Src^; Inc(Src); |
| 926 | Inc(x, 2); |
1271 | Inc(x, 2); |
| - | 1272 | end |
|
| 927 | end else |
1273 | else |
| - | 1274 | begin |
|
| - | 1275 | AllocByte^ := 1; |
|
| - | 1276 | AllocByte^ := Src^; Inc(Src); |
|
| - | 1277 | Inc(x); |
|
| - | 1278 | end; |
|
| - | 1279 | end |
|
| - | 1280 | else |
|
| 928 | begin |
1281 | begin |
| 929 | AllocByte^ := 1; |
- | |
| 930 | AllocByte^ := Src^; Inc(Src); |
- | |
| 931 | Inc(x); |
- | |
| 932 | end; |
- | |
| 933 | end else |
- | |
| 934 | begin |
- | |
| 935 | { Absolute mode } |
1282 | { Absolute mode } |
| 936 | PB1 := Size; AllocByte; |
1283 | PB1 := Size; AllocByte; |
| 937 | PB2 := Size; AllocByte; |
1284 | PB2 := Size; AllocByte; |
| 938 | 1285 | ||
| 939 | B1 := 0; |
1286 | B1 := 0; |
| 940 | B2 := 3; |
1287 | B2 := 3; |
| 941 | 1288 | ||
| 942 | Inc(x, 3); |
1289 | Inc(x, 3); |
| 943 | 1290 | ||
| 944 | AllocByte^ := Src^; Inc(Src); |
1291 | AllocByte^ := Src^; Inc(Src); |
| 945 | AllocByte^ := Src^; Inc(Src); |
1292 | AllocByte^ := Src^; Inc(Src); |
| 946 | AllocByte^ := Src^; Inc(Src); |
1293 | AllocByte^ := Src^; Inc(Src); |
| 947 | 1294 | ||
| 948 | while (x<Source.FWidth) and (B2<255) do |
1295 | while (x < Source.FWidth) and (B2 < 255) do |
| 949 | begin |
1296 | begin |
| 950 | if (Source.FWidth-x>3) and (Src^=PByte(Integer(Src)+1)^) and (Src^=PByte(Integer(Src)+2)^) and (Src^=PByte(Integer(Src)+3)^) then |
1297 | if (Source.FWidth - x > 3) and (Src^ = PByte(Integer(Src) + 1)^) and (Src^ = PByte(Integer(Src) + 2)^) and (Src^ = PByte(Integer(Src) + 3)^) then |
| 951 | Break; |
1298 | Break; |
| 952 | 1299 | ||
| 953 | AllocByte^ := Src^; Inc(Src); |
1300 | AllocByte^ := Src^; Inc(Src); |
| 954 | Inc(B2); |
1301 | Inc(B2); |
| 955 | Inc(x); |
1302 | Inc(x); |
| 956 | end; |
1303 | end; |
| 957 | 1304 | ||
| 958 | PByte(Integer(FPBits)+PB1)^ := B1; |
1305 | PByte(Integer(FPBits) + PB1)^ := B1; |
| 959 | PByte(Integer(FPBits)+PB2)^ := B2; |
1306 | PByte(Integer(FPBits) + PB2)^ := B2; |
| - | 1307 | end; |
|
| 960 | end; |
1308 | end; |
| 961 | end; |
- | |
| 962 | 1309 | ||
| 963 | if Size and 1=1 then AllocByte; |
1310 | if Size and 1 = 1 then AllocByte; |
| 964 | end; |
1311 | end; |
| 965 | 1312 | ||
| 966 | { End of line } |
1313 | { End of line } |
| 967 | AllocByte^ := 0; |
1314 | AllocByte^ := 0; |
| 968 | AllocByte^ := 0; |
1315 | AllocByte^ := 0; |
| Line 977... | Line 1324... | ||
| 977 | end; |
1324 | end; |
| 978 | 1325 | ||
| 979 | begin |
1326 | begin |
| 980 | if Source.FCompressed then |
1327 | if Source.FCompressed then |
| 981 | Duplicate(Source, Source.FMemoryImage) |
1328 | Duplicate(Source, Source.FMemoryImage) |
| - | 1329 | else |
|
| 982 | else begin |
1330 | begin |
| 983 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
1331 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| 984 | Source.FPixelFormat, Source.FColorTable, True, True); |
1332 | Source.FPixelFormat, Source.FColorTable, True, True); |
| 985 | case FBitmapInfo.bmiHeader.biCompression of |
1333 | case FBitmapInfo.bmiHeader.biCompression of |
| 986 | BI_RLE4: EncodeRLE4; |
1334 | BI_RLE4: EncodeRLE4; |
| 987 | BI_RLE8: EncodeRLE8; |
1335 | BI_RLE8: EncodeRLE8; |
| Line 1006... | Line 1354... | ||
| 1006 | while True do |
1354 | while True do |
| 1007 | begin |
1355 | begin |
| 1008 | B1 := Src^; Inc(Src); |
1356 | B1 := Src^; Inc(Src); |
| 1009 | B2 := Src^; Inc(Src); |
1357 | B2 := Src^; Inc(Src); |
| 1010 | 1358 | ||
| 1011 | if B1=0 then |
1359 | if B1 = 0 then |
| 1012 | begin |
1360 | begin |
| 1013 | case B2 of |
1361 | case B2 of |
| 1014 | 0: begin { End of line } |
1362 | 0: begin { End of line } |
| 1015 | X := 0; |
1363 | X := 0; |
| 1016 | Inc(Y); |
1364 | Inc(Y); |
| 1017 | end; |
1365 | end; |
| 1018 | 1: Break; { End of bitmap } |
1366 | 1: Break; { End of bitmap } |
| 1019 | 2: begin { Difference of coordinates } |
1367 | 2: begin { Difference of coordinates } |
| 1020 | Inc(X, B1); |
1368 | Inc(X, B1); |
| 1021 | Inc(Y, B2); Inc(Src, 2); |
1369 | Inc(Y, B2); Inc(Src, 2); |
| 1022 | end; |
1370 | end; |
| 1023 | else |
1371 | else |
| 1024 | { Absolute mode } |
1372 | { Absolute mode } |
| 1025 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes); |
1373 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes); |
| 1026 | 1374 | ||
| 1027 | C := 0; |
1375 | C := 0; |
| 1028 | for i:=0 to B2-1 do |
1376 | for i := 0 to B2 - 1 do |
| 1029 | begin |
1377 | begin |
| 1030 | if i and 1=0 then |
1378 | if i and 1 = 0 then |
| 1031 | begin |
1379 | begin |
| 1032 | C := Src^; Inc(Src); |
1380 | C := Src^; Inc(Src); |
| - | 1381 | end |
|
| 1033 | end else |
1382 | else |
| 1034 | begin |
1383 | begin |
| 1035 | C := C shl 4; |
1384 | C := C shl 4; |
| 1036 | end; |
1385 | end; |
| 1037 | 1386 | ||
| 1038 | P := Pointer(Integer(Dest)+X shr 1); |
1387 | P := Pointer(Integer(Dest) + X shr 1); |
| 1039 | if X and 1=0 then |
1388 | if X and 1 = 0 then |
| 1040 | P^ := (P^ and $0F) or (C and $F0) |
1389 | P^ := (P^ and $0F) or (C and $F0) |
| 1041 | else |
1390 | else |
| 1042 | P^ := (P^ and $F0) or ((C and $F0) shr 4); |
1391 | P^ := (P^ and $F0) or ((C and $F0) shr 4); |
| 1043 | 1392 | ||
| 1044 | Inc(X); |
1393 | Inc(X); |
| 1045 | end; |
1394 | end; |
| 1046 | end; |
1395 | end; |
| - | 1396 | end |
|
| 1047 | end else |
1397 | else |
| 1048 | begin |
1398 | begin |
| 1049 | { Encoding mode } |
1399 | { Encoding mode } |
| 1050 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes); |
1400 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes); |
| 1051 | 1401 | ||
| 1052 | for i:=0 to B1-1 do |
1402 | for i := 0 to B1 - 1 do |
| 1053 | begin |
1403 | begin |
| 1054 | P := Pointer(Integer(Dest)+X shr 1); |
1404 | P := Pointer(Integer(Dest) + X shr 1); |
| 1055 | if X and 1=0 then |
1405 | if X and 1 = 0 then |
| 1056 | P^ := (P^ and $0F) or (B2 and $F0) |
1406 | P^ := (P^ and $0F) or (B2 and $F0) |
| 1057 | else |
1407 | else |
| 1058 | P^ := (P^ and $F0) or ((B2 and $F0) shr 4); |
1408 | P^ := (P^ and $F0) or ((B2 and $F0) shr 4); |
| 1059 | 1409 | ||
| 1060 | Inc(X); |
1410 | Inc(X); |
| Line 1083... | Line 1433... | ||
| 1083 | while True do |
1433 | while True do |
| 1084 | begin |
1434 | begin |
| 1085 | B1 := Src^; Inc(Src); |
1435 | B1 := Src^; Inc(Src); |
| 1086 | B2 := Src^; Inc(Src); |
1436 | B2 := Src^; Inc(Src); |
| 1087 | 1437 | ||
| 1088 | if B1=0 then |
1438 | if B1 = 0 then |
| 1089 | begin |
1439 | begin |
| 1090 | case B2 of |
1440 | case B2 of |
| 1091 | 0: begin { End of line } |
1441 | 0: begin { End of line } |
| 1092 | X := 0; Inc(Y); |
1442 | X := 0; Inc(Y); |
| 1093 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes+X); |
1443 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X); |
| 1094 | end; |
1444 | end; |
| 1095 | 1: Break; { End of bitmap } |
1445 | 1: Break; { End of bitmap } |
| 1096 | 2: begin { Difference of coordinates } |
1446 | 2: begin { Difference of coordinates } |
| 1097 | Inc(X, B1); Inc(Y, B2); Inc(Src, 2); |
1447 | Inc(X, B1); Inc(Y, B2); Inc(Src, 2); |
| 1098 | Dest := Pointer(Longint(FPBits)+Y*FWidthBytes+X); |
1448 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X); |
| 1099 | end; |
1449 | end; |
| 1100 | else |
1450 | else |
| 1101 | { Absolute mode } |
1451 | { Absolute mode } |
| 1102 | Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2); |
1452 | Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2); |
| 1103 | end; |
1453 | end; |
| - | 1454 | end |
|
| 1104 | end else |
1455 | else |
| 1105 | begin |
1456 | begin |
| 1106 | { Encoding mode } |
1457 | { Encoding mode } |
| 1107 | FillChar(Dest^, B1, B2); Inc(Dest, B1); |
1458 | FillChar(Dest^, B1, B2); Inc(Dest, B1); |
| 1108 | end; |
1459 | end; |
| 1109 | 1460 | ||
| Line 1113... | Line 1464... | ||
| 1113 | end; |
1464 | end; |
| 1114 | 1465 | ||
| 1115 | begin |
1466 | begin |
| 1116 | if not Source.FCompressed then |
1467 | if not Source.FCompressed then |
| 1117 | Duplicate(Source, MemoryImage) |
1468 | Duplicate(Source, MemoryImage) |
| - | 1469 | else |
|
| 1118 | else begin |
1470 | begin |
| 1119 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
1471 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
| 1120 | Source.FPixelFormat, Source.FColorTable, MemoryImage, False); |
1472 | Source.FPixelFormat, Source.FColorTable, MemoryImage, False); |
| 1121 | case Source.FBitmapInfo.bmiHeader.biCompression of |
1473 | case Source.FBitmapInfo.bmiHeader.biCompression of |
| 1122 | BI_RLE4: DecodeRLE4; |
1474 | BI_RLE4: DecodeRLE4; |
| 1123 | BI_RLE8: DecodeRLE8; |
1475 | BI_RLE8: DecodeRLE8; |
| 1124 | else |
1476 | else |
| 1125 | Duplicate(Source, MemoryImage); |
1477 | Duplicate(Source, MemoryImage); |
| 1126 | end; |
1478 | end; |
| 1127 | end; |
1479 | end; |
| 1128 | end; |
1480 | end; |
| 1129 | 1481 | ||
| 1130 | procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean); |
1482 | procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean); |
| 1131 | var |
1483 | var |
| Line 1134... | Line 1486... | ||
| 1134 | BCRGB: array[0..255] of TRGBTriple; |
1486 | BCRGB: array[0..255] of TRGBTriple; |
| 1135 | 1487 | ||
| 1136 | procedure LoadRLE4; |
1488 | procedure LoadRLE4; |
| 1137 | begin |
1489 | begin |
| 1138 | FSize := BI.biSizeImage; |
1490 | FSize := BI.biSizeImage; |
| - | 1491 | //GetMem(FPBits, FSize); |
|
| 1139 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
1492 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
| 1140 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
1493 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
| 1141 | Stream.ReadBuffer(FPBits^, FSize); |
1494 | Stream.ReadBuffer(FPBits^, FSize); |
| 1142 | end; |
1495 | end; |
| 1143 | 1496 | ||
| 1144 | procedure LoadRLE8; |
1497 | procedure LoadRLE8; |
| 1145 | begin |
1498 | begin |
| 1146 | FSize := BI.biSizeImage; |
1499 | FSize := BI.biSizeImage; |
| - | 1500 | //GetMem(FPBits, FSize); |
|
| 1147 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
1501 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
| 1148 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
1502 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
| 1149 | Stream.ReadBuffer(FPBits^, FSize); |
1503 | Stream.ReadBuffer(FPBits^, FSize); |
| 1150 | end; |
1504 | end; |
| 1151 | 1505 | ||
| 1152 | procedure LoadRGB; |
1506 | procedure LoadRGB; |
| 1153 | var |
1507 | var |
| 1154 | y: Integer; |
1508 | y: Integer; |
| 1155 | begin |
1509 | begin |
| 1156 | if BI.biHeight<0 then |
1510 | if BI.biHeight < 0 then |
| 1157 | begin |
1511 | begin |
| 1158 | for y:=0 to Abs(BI.biHeight)-1 do |
1512 | for y := 0 to Abs(BI.biHeight) - 1 do |
| 1159 | Stream.ReadBuffer(Pointer(Integer(FTopPBits)+y*FNextLine)^, FWidthBytes); |
1513 | Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes); |
| - | 1514 | end |
|
| 1160 | end else |
1515 | else |
| 1161 | begin |
1516 | begin |
| 1162 | Stream.ReadBuffer(FPBits^, FSize); |
1517 | Stream.ReadBuffer(FPBits^, FSize); |
| 1163 | end; |
1518 | end; |
| 1164 | end; |
1519 | end; |
| 1165 | 1520 | ||
| Line 1168... | Line 1523... | ||
| 1168 | OS2: Boolean; |
1523 | OS2: Boolean; |
| 1169 | Localpf: TLocalDIBPixelFormat; |
1524 | Localpf: TLocalDIBPixelFormat; |
| 1170 | AColorTable: TRGBQuads; |
1525 | AColorTable: TRGBQuads; |
| 1171 | APixelFormat: TDIBPixelFormat; |
1526 | APixelFormat: TDIBPixelFormat; |
| 1172 | begin |
1527 | begin |
| - | 1528 | if not Assigned(Stream) then Exit; |
|
| - | 1529 | ||
| 1173 | { Header size reading } |
1530 | { Header size reading } |
| 1174 | i := Stream.Read(BI.biSize, 4); |
1531 | i := Stream.Read(BI.biSize, 4); |
| 1175 | 1532 | ||
| 1176 | if i=0 then |
1533 | if i = 0 then |
| 1177 | begin |
1534 | begin |
| - | 1535 | {$IFNDEF D17UP} |
|
| - | 1536 | {self recreation is not allowed here} |
|
| 1178 | Create; |
1537 | Create; |
| - | 1538 | {$ENDIF} |
|
| 1179 | Exit; |
1539 | Exit; |
| 1180 | end; |
1540 | end; |
| 1181 | if i<>4 then |
1541 | if i <> 4 then |
| 1182 | raise EInvalidGraphic.Create(SInvalidDIB); |
1542 | raise EInvalidGraphic.Create(SInvalidDIB); |
| 1183 | 1543 | ||
| 1184 | { Kind check of DIB } |
1544 | { Kind check of DIB } |
| 1185 | OS2 := False; |
1545 | OS2 := False; |
| 1186 | 1546 | ||
| 1187 | case BI.biSize of |
1547 | case BI.biSize of |
| 1188 | SizeOf(TBitmapCoreHeader): |
1548 | SizeOf(TBitmapCoreHeader): |
| 1189 | begin |
1549 | begin |
| 1190 | { OS/2 type } |
1550 | { OS/2 type } |
| 1191 | Stream.ReadBuffer(Pointer(Integer(@BC)+4)^, SizeOf(TBitmapCoreHeader)-4); |
1551 | Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4); |
| 1192 | 1552 | ||
| 1193 | with BI do |
1553 | with BI do |
| 1194 | begin |
1554 | begin |
| 1195 | biClrUsed := 0; |
1555 | biClrUsed := 0; |
| 1196 | biCompression := BI_RGB; |
1556 | biCompression := BI_RGB; |
| Line 1202... | Line 1562... | ||
| 1202 | OS2 := True; |
1562 | OS2 := True; |
| 1203 | end; |
1563 | end; |
| 1204 | SizeOf(TBitmapInfoHeader): |
1564 | SizeOf(TBitmapInfoHeader): |
| 1205 | begin |
1565 | begin |
| 1206 | { Windows type } |
1566 | { Windows type } |
| 1207 | Stream.ReadBuffer(Pointer(Integer(@BI)+4)^, SizeOf(TBitmapInfoHeader)-4); |
1567 | Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4); |
| 1208 | end; |
1568 | end; |
| 1209 | else |
1569 | else |
| 1210 | raise EInvalidGraphic.Create(SInvalidDIB); |
1570 | raise EInvalidGraphic.Create(SInvalidDIB); |
| 1211 | end; |
1571 | end; |
| 1212 | 1572 | ||
| Line 1214... | Line 1574... | ||
| 1214 | if BI.biCompression = BI_BITFIELDS then |
1574 | if BI.biCompression = BI_BITFIELDS then |
| 1215 | begin |
1575 | begin |
| 1216 | Stream.ReadBuffer(Localpf, SizeOf(Localpf)); |
1576 | Stream.ReadBuffer(Localpf, SizeOf(Localpf)); |
| 1217 | with Localpf do |
1577 | with Localpf do |
| 1218 | APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask); |
1578 | APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask); |
| - | 1579 | end |
|
| 1219 | end else |
1580 | else |
| 1220 | begin |
1581 | begin |
| 1221 | if BI.biBitCount=16 then |
1582 | if BI.biBitCount = 16 then |
| 1222 | APixelFormat := MakeDIBPixelFormat(5, 5, 5) |
1583 | APixelFormat := MakeDIBPixelFormat(5, 5, 5) |
| 1223 | else if BI.biBitCount=32 then |
1584 | else if BI.biBitCount = 32 then |
| 1224 | APixelFormat := MakeDIBPixelFormat(8, 8, 8) |
1585 | APixelFormat := MakeDIBPixelFormat(8, 8, 8) |
| 1225 | else |
1586 | else |
| 1226 | APixelFormat := MakeDIBPixelFormat(8, 8, 8); |
1587 | APixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| 1227 | end; |
1588 | end; |
| 1228 | 1589 | ||
| 1229 | { Palette reading } |
1590 | { Palette reading } |
| 1230 | PalCount := BI.biClrUsed; |
1591 | PalCount := BI.biClrUsed; |
| 1231 | if (PalCount=0) and (BI.biBitCount<=8) then |
1592 | if (PalCount = 0) and (BI.biBitCount <= 8) then |
| 1232 | PalCount := 1 shl BI.biBitCount; |
1593 | PalCount := 1 shl BI.biBitCount; |
| 1233 | if PalCount>256 then PalCount := 256; |
1594 | if PalCount > 256 then PalCount := 256; |
| 1234 | 1595 | ||
| 1235 | FillChar(AColorTable, SizeOf(AColorTable), 0); |
1596 | FillChar(AColorTable, SizeOf(AColorTable), 0); |
| 1236 | 1597 | ||
| 1237 | if OS2 then |
1598 | if OS2 then |
| 1238 | begin |
1599 | begin |
| 1239 | { OS/2 type } |
1600 | { OS/2 type } |
| 1240 | Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple)*PalCount); |
1601 | Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple) * PalCount); |
| 1241 | for i:=0 to PalCount-1 do |
1602 | for i := 0 to PalCount - 1 do |
| 1242 | begin |
1603 | begin |
| 1243 | with BCRGB[i] do |
1604 | with BCRGB[i] do |
| 1244 | AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue); |
1605 | AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue); |
| 1245 | end; |
1606 | end; |
| - | 1607 | end |
|
| 1246 | end else |
1608 | else |
| 1247 | begin |
1609 | begin |
| 1248 | { Windows type } |
1610 | { Windows type } |
| 1249 | Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad)*PalCount); |
1611 | Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount); |
| 1250 | end; |
1612 | end; |
| 1251 | 1613 | ||
| 1252 | { DIB ì¬ } |
1614 | { DIB compilation } |
| 1253 | NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable, |
1615 | NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable, |
| 1254 | MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]); |
1616 | MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]); |
| 1255 | 1617 | ||
| 1256 | { Pixel data reading } |
1618 | { Pixel data reading } |
| 1257 | case BI.biCompression of |
1619 | case BI.biCompression of |
| 1258 | BI_RGB : LoadRGB; |
1620 | BI_RGB: LoadRGB; |
| 1259 | BI_RLE4 : LoadRLE4; |
1621 | BI_RLE4: LoadRLE4; |
| 1260 | BI_RLE8 : LoadRLE8; |
1622 | BI_RLE8: LoadRLE8; |
| 1261 | BI_BITFIELDS: LoadRGB; |
1623 | BI_BITFIELDS: LoadRGB; |
| 1262 | else |
1624 | else |
| 1263 | raise EInvalidGraphic.Create(SInvalidDIB); |
1625 | raise EInvalidGraphic.Create(SInvalidDIB); |
| 1264 | end; |
1626 | end; |
| 1265 | end; |
1627 | end; |
| 1266 | 1628 | ||
| 1267 | destructor TDIBSharedImage.Destroy; |
1629 | destructor TDIBSharedImage.Destroy; |
| 1268 | begin |
1630 | begin |
| 1269 | if FHandle<>0 then |
1631 | if FHandle <> 0 then |
| 1270 | begin |
1632 | begin |
| 1271 | if FOldHandle<>0 then SelectObject(FDC, FOldHandle); |
1633 | if FOldHandle <> 0 then SelectObject(FDC, FOldHandle); |
| 1272 | DeleteObject(FHandle); |
1634 | DeleteObject(FHandle); |
| - | 1635 | end |
|
| 1273 | end else |
1636 | else |
| - | 1637 | // GlobalFree(THandle(FPBits)); |
|
| 1274 | begin |
1638 | begin |
| 1275 | if FPBits<>nil then |
1639 | if FPBits <> nil then |
| 1276 | GlobalFreePtr(FPBits); |
1640 | GlobalFreePtr(FPBits); |
| 1277 | end; |
1641 | end; |
| 1278 | 1642 | ||
| 1279 | PaletteManager.DeletePalette(FPalette); |
1643 | PaletteManager.DeletePalette(FPalette); |
| 1280 | if FDC<>0 then DeleteDC(FDC); |
1644 | if FDC <> 0 then DeleteDC(FDC); |
| 1281 | 1645 | ||
| 1282 | FreeMem(FBitmapInfo); |
1646 | FreeMem(FBitmapInfo); |
| 1283 | inherited Destroy; |
1647 | inherited Destroy; |
| 1284 | end; |
1648 | end; |
| 1285 | 1649 | ||
| Line 1287... | Line 1651... | ||
| 1287 | begin |
1651 | begin |
| 1288 | end; |
1652 | end; |
| 1289 | 1653 | ||
| 1290 | function TDIBSharedImage.GetPalette: THandle; |
1654 | function TDIBSharedImage.GetPalette: THandle; |
| 1291 | begin |
1655 | begin |
| 1292 | if FPaletteCount>0 then |
1656 | if FPaletteCount > 0 then |
| 1293 | begin |
1657 | begin |
| 1294 | if FChangePalette then |
1658 | if FChangePalette then |
| 1295 | begin |
1659 | begin |
| 1296 | FChangePalette := False; |
1660 | FChangePalette := False; |
| 1297 | PaletteManager.DeletePalette(FPalette); |
1661 | PaletteManager.DeletePalette(FPalette); |
| Line 1305... | Line 1669... | ||
| 1305 | procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads); |
1669 | procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads); |
| 1306 | begin |
1670 | begin |
| 1307 | FColorTable := Value; |
1671 | FColorTable := Value; |
| 1308 | FChangePalette := True; |
1672 | FChangePalette := True; |
| 1309 | 1673 | ||
| 1310 | if (FSize>0) and (FPaletteCount>0) then |
1674 | if (FSize > 0) and (FPaletteCount > 0) then |
| 1311 | begin |
1675 | begin |
| 1312 | SetDIBColorTable(FDC, 0, 256, FColorTable); |
1676 | SetDIBColorTable(FDC, 0, 256, FColorTable); |
| 1313 | Move(FColorTable, Pointer(Integer(FBitmapInfo)+FColorTablePos)^, SizeOf(TRGBQuad)*FPaletteCount); |
1677 | Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount); |
| 1314 | end; |
1678 | end; |
| 1315 | end; |
1679 | end; |
| 1316 | 1680 | ||
| 1317 | { TDIB } |
1681 | { TDIB } |
| 1318 | 1682 | ||
| 1319 | var |
1683 | var |
| 1320 | FEmptyDIBImage: TDIBSharedImage; |
1684 | FEmptyDIBImage: TDIBSharedImage; |
| 1321 | 1685 | ||
| 1322 | function EmptyDIBImage: TDIBSharedImage; |
1686 | function EmptyDIBImage: TDIBSharedImage; |
| 1323 | begin |
1687 | begin |
| 1324 | if FEmptyDIBImage=nil then |
1688 | if FEmptyDIBImage = nil then |
| 1325 | begin |
1689 | begin |
| 1326 | FEmptyDIBImage := TDIBSharedImage.Create; |
1690 | FEmptyDIBImage := TDIBSharedImage.Create; |
| 1327 | FEmptyDIBImage.Reference; |
1691 | FEmptyDIBImage.Reference; |
| 1328 | end; |
1692 | end; |
| 1329 | Result := FEmptyDIBImage; |
1693 | Result := FEmptyDIBImage; |
| Line 1331... | Line 1695... | ||
| 1331 | 1695 | ||
| 1332 | constructor TDIB.Create; |
1696 | constructor TDIB.Create; |
| 1333 | begin |
1697 | begin |
| 1334 | inherited Create; |
1698 | inherited Create; |
| 1335 | SetImage(EmptyDIBImage); |
1699 | SetImage(EmptyDIBImage); |
| - | 1700 | ||
| - | 1701 | FFreeList := TList.Create; |
|
| 1336 | end; |
1702 | end; |
| 1337 | 1703 | ||
| 1338 | destructor TDIB.Destroy; |
1704 | destructor TDIB.Destroy; |
| - | 1705 | var |
|
| - | 1706 | D: TDIB; |
|
| 1339 | begin |
1707 | begin |
| 1340 | SetImage(EmptyDIBImage); |
1708 | SetImage(EmptyDIBImage); |
| 1341 | FCanvas.Free; |
1709 | FCanvas.Free; |
| - | 1710 | ||
| - | 1711 | while FFreeList.Count > 0 do |
|
| - | 1712 | try |
|
| - | 1713 | D := TDIB(FFreeList[0]); |
|
| - | 1714 | FFreeList.Remove(D); |
|
| - | 1715 | D.Free; |
|
| - | 1716 | except |
|
| - | 1717 | end; |
|
| - | 1718 | FFreeList.Free; |
|
| - | 1719 | ||
| 1342 | inherited Destroy; |
1720 | inherited Destroy; |
| 1343 | end; |
1721 | end; |
| 1344 | 1722 | ||
| 1345 | procedure TDIB.Assign(Source: TPersistent); |
1723 | procedure TDIB.Assign(Source: TPersistent); |
| 1346 | 1724 | ||
| Line 1355... | Line 1733... | ||
| 1355 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
1733 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
| 1356 | UpdatePalette; |
1734 | UpdatePalette; |
| 1357 | 1735 | ||
| 1358 | case GetObject(Source.Handle, SizeOf(Data), @Data) of |
1736 | case GetObject(Source.Handle, SizeOf(Data), @Data) of |
| 1359 | SizeOf(Windows.TBitmap): |
1737 | SizeOf(Windows.TBitmap): |
| 1360 | begin |
1738 | begin |
| 1361 | BitmapRec := @Data; |
1739 | BitmapRec := @Data; |
| 1362 | case BitmapRec^.bmBitsPixel of |
1740 | case BitmapRec^.bmBitsPixel of |
| 1363 | 16: PixelFormat := MakeDIBPixelFormat(5, 5, 5); |
1741 | 16: PixelFormat := MakeDIBPixelFormat(5, 5, 5); |
| 1364 | else |
1742 | else |
| 1365 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
1743 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| 1366 | end; |
- | |
| 1367 | SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel); |
- | |
| 1368 | end; |
1744 | end; |
| - | 1745 | SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel); |
|
| - | 1746 | end; |
|
| 1369 | SizeOf(TDIBSection): |
1747 | SizeOf(TDIBSection): |
| - | 1748 | begin |
|
| - | 1749 | DIBSectionRec := @Data; |
|
| - | 1750 | if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then |
|
| 1370 | begin |
1751 | begin |
| 1371 | DIBSectionRec := @Data; |
- | |
| 1372 | if DIBSectionRec^.dsBm.bmBitsPixel>=24 then |
1752 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| 1373 | begin |
1753 | end |
| 1374 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
- | |
| 1375 | end else |
1754 | else |
| 1376 | if DIBSectionRec^.dsBm.bmBitsPixel>8 then |
1755 | if DIBSectionRec^.dsBm.bmBitsPixel > 8 then |
| 1377 | begin |
1756 | begin |
| 1378 | PixelFormat := MakeDIBPixelFormat(DIBSectionRec^.dsBitfields[0], |
1757 | PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks |
| 1379 | DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]); |
1758 | DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]); |
| - | 1759 | end |
|
| 1380 | end else |
1760 | else |
| 1381 | begin |
1761 | begin |
| 1382 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
1762 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
| 1383 | end; |
1763 | end; |
| 1384 | SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight, |
1764 | SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight, |
| 1385 | DIBSectionRec^.dsBm.bmBitsPixel); |
1765 | DIBSectionRec^.dsBm.bmBitsPixel); |
| 1386 | end; |
1766 | end; |
| 1387 | else |
1767 | else |
| 1388 | Exit; |
1768 | Exit; |
| 1389 | end; |
1769 | end; |
| 1390 | 1770 | ||
| 1391 | FillChar(PBits^, Size, 0); |
1771 | FillChar(PBits^, Size, 0); |
| 1392 | Canvas.Draw(0, 0, Source); |
1772 | Canvas.Draw(0, 0, Source); |
| 1393 | end; |
1773 | end; |
| 1394 | 1774 | ||
| 1395 | procedure AssignGraphic(Source: TGraphic); |
1775 | procedure AssignGraphic(Source: TGraphic); |
| - | 1776 | {$IFDEF PNG_GRAPHICS} |
|
| - | 1777 | var |
|
| - | 1778 | alpha: TDIB; |
|
| - | 1779 | png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}; |
|
| - | 1780 | i, j: Integer; |
|
| - | 1781 | q: pByteArray; |
|
| - | 1782 | {$ENDIF} |
|
| 1396 | begin |
1783 | begin |
| - | 1784 | {$IFDEF PNG_GRAPHICS} |
|
| - | 1785 | if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then |
|
| - | 1786 | begin |
|
| - | 1787 | alpha := TDIB.Create; |
|
| - | 1788 | try |
|
| - | 1789 | {png image} |
|
| - | 1790 | png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create; |
|
| - | 1791 | try |
|
| - | 1792 | png.Assign(Source); |
|
| - | 1793 | if png.TransparencyMode = ptmPartial then |
|
| - | 1794 | begin |
|
| - | 1795 | Alpha.SetSize(png.Width, png.Height, 8); |
|
| - | 1796 | {separate alpha} |
|
| - | 1797 | for i := 0 to png.Height - 1 do |
|
| - | 1798 | begin |
|
| - | 1799 | q := png.AlphaScanline[i]; |
|
| - | 1800 | for j := 0 to png.Width - 1 do |
|
| - | 1801 | alpha.Pixels[j,i] := q[j]; |
|
| - | 1802 | end; |
|
| - | 1803 | end; |
|
| - | 1804 | SetSize(png.Width, png.Height, 32); |
|
| - | 1805 | FillChar(PBits^, Size, 0); |
|
| - | 1806 | Canvas.Draw(0, 0, png); |
|
| - | 1807 | Transparent := png.Transparent; |
|
| - | 1808 | finally |
|
| - | 1809 | png.Free; |
|
| - | 1810 | end; |
|
| - | 1811 | if not alpha.Empty then |
|
| - | 1812 | AssignAlphaChannel(alpha); |
|
| - | 1813 | finally |
|
| - | 1814 | alpha.Free; |
|
| - | 1815 | end; |
|
| - | 1816 | end |
|
| - | 1817 | else |
|
| - | 1818 | {$ENDIF} |
|
| 1397 | if Source is TBitmap then |
1819 | if Source is TBitmap then |
| 1398 | AssignBitmap(TBitmap(Source)) |
1820 | AssignBitmap(TBitmap(Source)) |
| 1399 | else |
1821 | else |
| 1400 | begin |
1822 | begin |
| 1401 | SetSize(Source.Width, Source.Height, 24); |
1823 | SetSize(Source.Width, Source.Height, 32); |
| 1402 | FillChar(PBits^, Size, 0); |
1824 | FillChar(PBits^, Size, 0); |
| 1403 | Canvas.Draw(0, 0, Source); |
1825 | Canvas.Draw(0, 0, Source); |
| - | 1826 | Transparent := Source.Transparent; |
|
| - | 1827 | if not HasAlphaChannel then |
|
| - | 1828 | begin |
|
| - | 1829 | SetSize(Source.Width, Source.Height, 24); |
|
| - | 1830 | FillChar(PBits^, Size, 0); |
|
| - | 1831 | Canvas.Draw(0, 0, Source); |
|
| - | 1832 | Transparent := Source.Transparent; |
|
| - | 1833 | end |
|
| 1404 | end; |
1834 | end; |
| 1405 | end; |
1835 | end; |
| 1406 | 1836 | ||
| 1407 | begin |
1837 | begin |
| 1408 | if Source=nil then |
1838 | if Source = nil then |
| 1409 | begin |
1839 | begin |
| 1410 | Clear; |
1840 | Clear; |
| 1411 | end else if Source is TDIB then |
1841 | end else if Source is TDIB then |
| 1412 | begin |
1842 | begin |
| 1413 | if Source<>Self then |
1843 | if Source <> Self then |
| 1414 | SetImage(TDIB(Source).FImage); |
1844 | SetImage(TDIB(Source).FImage); |
| 1415 | end else if Source is TGraphic then |
1845 | end else if Source is TGraphic then |
| 1416 | begin |
1846 | begin |
| 1417 | AssignGraphic(TGraphic(Source)); |
1847 | AssignGraphic(TGraphic(Source)); |
| 1418 | end else if Source is TPicture then |
1848 | end else if Source is TPicture then |
| 1419 | begin |
1849 | begin |
| 1420 | if TPicture(Source).Graphic<>nil then |
1850 | if TPicture(Source).Graphic <> nil then |
| 1421 | AssignGraphic(TPicture(Source).Graphic) |
1851 | AssignGraphic(TPicture(Source).Graphic) |
| 1422 | else |
1852 | else |
| 1423 | Clear; |
1853 | Clear; |
| 1424 | end else |
1854 | end else |
| 1425 | inherited Assign(Source); |
1855 | inherited Assign(Source); |
| 1426 | end; |
1856 | end; |
| 1427 | 1857 | ||
| 1428 | procedure TDIB.Draw(ACanvas: TCanvas; const Rect: TRect); |
1858 | procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect); |
| 1429 | var |
1859 | var |
| 1430 | OldPalette: HPalette; |
1860 | OldPalette: HPalette; |
| 1431 | OldMode: Integer; |
1861 | OldMode: Integer; |
| 1432 | begin |
1862 | begin |
| 1433 | if Size>0 then |
1863 | if Size > 0 then |
| 1434 | begin |
1864 | begin |
| 1435 | if PaletteCount>0 then |
1865 | if PaletteCount > 0 then |
| 1436 | begin |
1866 | begin |
| 1437 | OldPalette := SelectPalette(ACanvas.Handle, Palette, False); |
1867 | OldPalette := SelectPalette(ACanvas.Handle, Palette, False); |
| 1438 | RealizePalette(ACanvas.Handle); |
1868 | RealizePalette(ACanvas.Handle); |
| - | 1869 | end |
|
| 1439 | end else |
1870 | else |
| 1440 | OldPalette := 0; |
1871 | OldPalette := 0; |
| 1441 | try |
1872 | try |
| 1442 | OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR); |
1873 | OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR); |
| 1443 | try |
1874 | try |
| 1444 | GdiFlush; |
1875 | GdiFlush; |
| 1445 | if FImage.FMemoryImage then |
1876 | if FImage.FMemoryImage then |
| 1446 | begin |
1877 | begin |
| 1447 | with Rect do |
1878 | with ARect do |
| - | 1879 | begin |
|
| 1448 | StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
1880 | if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
| 1449 | 0, 0, Width, Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS , ACanvas.CopyMode); |
1881 | 0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then |
| - | 1882 | MessageBeep(1); |
|
| - | 1883 | end; |
|
| - | 1884 | end |
|
| 1450 | end else |
1885 | else |
| 1451 | begin |
1886 | begin |
| 1452 | with Rect do |
1887 | with ARect do |
| 1453 | StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
1888 | StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
| 1454 | FImage.FDC, 0, 0, Width, Height, ACanvas.CopyMode); |
1889 | FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode); |
| 1455 | end; |
1890 | end; |
| 1456 | finally |
1891 | finally |
| 1457 | SetStretchBltMode(ACanvas.Handle, OldMode); |
1892 | SetStretchBltMode(ACanvas.Handle, OldMode); |
| 1458 | end; |
1893 | end; |
| 1459 | finally |
1894 | finally |
| Line 1474... | Line 1909... | ||
| 1474 | 1909 | ||
| 1475 | procedure TDIB.Changing(MemoryImage: Boolean); |
1910 | procedure TDIB.Changing(MemoryImage: Boolean); |
| 1476 | var |
1911 | var |
| 1477 | TempImage: TDIBSharedImage; |
1912 | TempImage: TDIBSharedImage; |
| 1478 | begin |
1913 | begin |
| 1479 | if (FImage.RefCount>1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then |
1914 | if (FImage.RefCount > 1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then |
| 1480 | begin |
1915 | begin |
| 1481 | TempImage := TDIBSharedImage.Create; |
1916 | TempImage := TDIBSharedImage.Create; |
| 1482 | try |
1917 | try |
| 1483 | TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage); |
1918 | TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage); |
| 1484 | except |
1919 | except |
| Line 1555... | Line 1990... | ||
| 1555 | end; |
1990 | end; |
| 1556 | SetImage(TempImage); |
1991 | SetImage(TempImage); |
| 1557 | end; |
1992 | end; |
| 1558 | end; |
1993 | end; |
| 1559 | 1994 | ||
| - | 1995 | type |
|
| - | 1996 | PRGBA = ^TRGBA; |
|
| - | 1997 | TRGBA = array[0..0] of Windows.TRGBQuad; |
|
| - | 1998 | ||
| - | 1999 | function TDIB.HasAlphaChannel: Boolean; |
|
| - | 2000 | {give that DIB contain the alphachannel} |
|
| - | 2001 | var |
|
| - | 2002 | p: PRGBA; |
|
| - | 2003 | X, Y: Integer; |
|
| - | 2004 | begin |
|
| - | 2005 | Result := True; |
|
| - | 2006 | if BitCount = 32 then |
|
| - | 2007 | for Y := 0 to Height - 1 do |
|
| - | 2008 | begin |
|
| - | 2009 | p := ScanLine[Y]; |
|
| - | 2010 | for X := 0 to Width - 1 do |
|
| - | 2011 | begin |
|
| - | 2012 | if p[X].rgbReserved <> $0 then Exit; |
|
| - | 2013 | end |
|
| - | 2014 | end; |
|
| - | 2015 | Result := False; |
|
| - | 2016 | end; |
|
| - | 2017 | ||
| - | 2018 | function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean; |
|
| - | 2019 | {copy alphachannel from other DIB or add from DIB8} |
|
| - | 2020 | var |
|
| - | 2021 | p32_0, p32_1: PRGBA; |
|
| - | 2022 | p24: Pointer; |
|
| - | 2023 | pB: PArrayByte; |
|
| - | 2024 | X, Y: Integer; |
|
| - | 2025 | tmpDIB, qAlpha: TDIB; |
|
| - | 2026 | begin |
|
| - | 2027 | Result := False; |
|
| - | 2028 | if GetEmpty then Exit; |
|
| - | 2029 | {Alphachannel can be copy into 32bit DIB only!} |
|
| - | 2030 | if BitCount <> 32 then |
|
| - | 2031 | begin |
|
| - | 2032 | tmpDIB := TDIB.Create; |
|
| - | 2033 | try |
|
| - | 2034 | tmpDIB.Assign(Self); |
|
| - | 2035 | Clear; |
|
| - | 2036 | SetSize(tmpDIB.Width, tmpDIB.Height, 32); |
|
| - | 2037 | Canvas.Draw(0, 0, tmpDIB); |
|
| - | 2038 | finally |
|
| - | 2039 | tmpDIB.Free; |
|
| - | 2040 | end; |
|
| - | 2041 | end; |
|
| - | 2042 | qAlpha := TDIB.Create; |
|
| - | 2043 | try |
|
| - | 2044 | if not Assigned(Alpha) then Exit; |
|
| - | 2045 | if ForceResize then |
|
| - | 2046 | begin |
|
| - | 2047 | {create temp} |
|
| - | 2048 | tmpDIB := TDIB.Create; |
|
| - | 2049 | try |
|
| - | 2050 | {picture} |
|
| - | 2051 | tmpDIB.Assign(ALPHA); |
|
| - | 2052 | {resample size} |
|
| - | 2053 | tmpDIB.DoResample(Width, Height, ftrBSpline); |
|
| - | 2054 | {convert to greyscale} |
|
| - | 2055 | tmpDIB.Greyscale(8); |
|
| - | 2056 | {return picture to qAlpha} |
|
| - | 2057 | qAlpha.Assign(tmpDIB); |
|
| - | 2058 | finally |
|
| - | 2059 | tmpDIB.Free; |
|
| - | 2060 | end; |
|
| - | 2061 | end |
|
| - | 2062 | else |
|
| - | 2063 | {Must be the same size!} |
|
| - | 2064 | if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit |
|
| - | 2065 | else qAlpha.Assign(ALPHA); |
|
| - | 2066 | {It works now with qAlpha only} |
|
| - | 2067 | case qAlpha.BitCount of |
|
| - | 2068 | 24: |
|
| - | 2069 | begin |
|
| - | 2070 | for Y := 0 to Height - 1 do |
|
| - | 2071 | begin |
|
| - | 2072 | p32_0 := ScanLine[Y]; |
|
| - | 2073 | p24 := qAlpha.ScanLine[Y]; |
|
| - | 2074 | for X := 0 to Width - 1 do with PBGR(p24)^ do |
|
| - | 2075 | begin |
|
| - | 2076 | p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B); |
|
| - | 2077 | end |
|
| - | 2078 | end; |
|
| - | 2079 | end; |
|
| - | 2080 | 32: |
|
| - | 2081 | begin |
|
| - | 2082 | for Y := 0 to Height - 1 do |
|
| - | 2083 | begin |
|
| - | 2084 | p32_0 := ScanLine[Y]; |
|
| - | 2085 | p32_1 := qAlpha.ScanLine[Y]; |
|
| - | 2086 | for X := 0 to Width - 1 do |
|
| - | 2087 | begin |
|
| - | 2088 | p32_0[X].rgbReserved := p32_1[X].rgbReserved; |
|
| - | 2089 | end |
|
| - | 2090 | end; |
|
| - | 2091 | end; |
|
| - | 2092 | 8: |
|
| - | 2093 | begin |
|
| - | 2094 | for Y := 0 to Height - 1 do |
|
| - | 2095 | begin |
|
| - | 2096 | p32_0 := ScanLine[Y]; |
|
| - | 2097 | pB := qAlpha.ScanLine[Y]; |
|
| - | 2098 | for X := 0 to Width - 1 do |
|
| - | 2099 | begin |
|
| - | 2100 | p32_0[X].rgbReserved := pB[X]; |
|
| - | 2101 | end |
|
| - | 2102 | end; |
|
| - | 2103 | end; |
|
| - | 2104 | 1: |
|
| - | 2105 | begin |
|
| - | 2106 | for Y := 0 to Height - 1 do |
|
| - | 2107 | begin |
|
| - | 2108 | p32_0 := ScanLine[Y]; |
|
| - | 2109 | pB := qAlpha.ScanLine[Y]; |
|
| - | 2110 | for X := 0 to Width - 1 do |
|
| - | 2111 | begin |
|
| - | 2112 | if pB[X] = 0 then |
|
| - | 2113 | p32_0[X].rgbReserved := $FF |
|
| - | 2114 | else |
|
| - | 2115 | p32_0[X].rgbReserved := 0 |
|
| - | 2116 | end |
|
| - | 2117 | end; |
|
| - | 2118 | end; |
|
| - | 2119 | else |
|
| - | 2120 | Exit; |
|
| - | 2121 | end; |
|
| - | 2122 | Result := True; |
|
| - | 2123 | finally |
|
| - | 2124 | qAlpha.Free; |
|
| - | 2125 | end; |
|
| - | 2126 | end; |
|
| - | 2127 | ||
| - | 2128 | procedure TDIB.RetAlphaChannel(out oDIB: TDIB); |
|
| - | 2129 | {Store alphachannel information into DIB8} |
|
| - | 2130 | var |
|
| - | 2131 | p0: PRGBA; |
|
| - | 2132 | pB: PArrayByte; |
|
| - | 2133 | X, Y: Integer; |
|
| - | 2134 | begin |
|
| - | 2135 | oDIB := nil; |
|
| - | 2136 | if not HasAlphaChannel then exit; |
|
| - | 2137 | oDIB := TDIB.Create; |
|
| - | 2138 | oDIB.SetSize(Width, Height, 8); |
|
| - | 2139 | for Y := 0 to Height - 1 do |
|
| - | 2140 | begin |
|
| - | 2141 | p0 := ScanLine[Y]; |
|
| - | 2142 | pB := oDIB.ScanLine[Y]; |
|
| - | 2143 | for X := 0 to Width - 1 do |
|
| - | 2144 | begin |
|
| - | 2145 | pB[X] := p0[X].rgbReserved; |
|
| - | 2146 | end |
|
| - | 2147 | end; |
|
| - | 2148 | end; |
|
| - | 2149 | ||
| 1560 | function TDIB.GetBitmapInfo: PBitmapInfo; |
2150 | function TDIB.GetBitmapInfo: PBitmapInfo; |
| 1561 | begin |
2151 | begin |
| 1562 | Result := FImage.FBitmapInfo; |
2152 | Result := FImage.FBitmapInfo; |
| 1563 | end; |
2153 | end; |
| 1564 | 2154 | ||
| Line 1567... | Line 2157... | ||
| 1567 | Result := FImage.FBitmapInfoSize; |
2157 | Result := FImage.FBitmapInfoSize; |
| 1568 | end; |
2158 | end; |
| 1569 | 2159 | ||
| 1570 | function TDIB.GetCanvas: TCanvas; |
2160 | function TDIB.GetCanvas: TCanvas; |
| 1571 | begin |
2161 | begin |
| 1572 | if (FCanvas=nil) or (FCanvas.Handle=0) then |
2162 | if (FCanvas = nil) or (FCanvas.Handle = 0) then |
| 1573 | begin |
2163 | begin |
| 1574 | AllocHandle; |
2164 | AllocHandle; |
| 1575 | 2165 | ||
| 1576 | FCanvas := TCanvas.Create; |
2166 | FCanvas := TCanvas.Create; |
| 1577 | FCanvas.Handle := FImage.FDC; |
2167 | FCanvas.Handle := FImage.FDC; |
| Line 1580... | Line 2170... | ||
| 1580 | Result := FCanvas; |
2170 | Result := FCanvas; |
| 1581 | end; |
2171 | end; |
| 1582 | 2172 | ||
| 1583 | function TDIB.GetEmpty: Boolean; |
2173 | function TDIB.GetEmpty: Boolean; |
| 1584 | begin |
2174 | begin |
| 1585 | Result := Size=0; |
2175 | Result := Size = 0; |
| 1586 | end; |
2176 | end; |
| 1587 | 2177 | ||
| 1588 | function TDIB.GetHandle: THandle; |
2178 | function TDIB.GetHandle: THandle; |
| 1589 | begin |
2179 | begin |
| 1590 | Changing(True); |
2180 | Changing(True); |
| Line 1623... | Line 2213... | ||
| 1623 | end; |
2213 | end; |
| 1624 | 2214 | ||
| 1625 | function TDIB.GetScanLine(Y: Integer): Pointer; |
2215 | function TDIB.GetScanLine(Y: Integer): Pointer; |
| 1626 | begin |
2216 | begin |
| 1627 | Changing(True); |
2217 | Changing(True); |
| 1628 | if (Y<0) or (Y>=FHeight) then |
2218 | if (Y < 0) or (Y >= FHeight) then |
| 1629 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
2219 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
| 1630 | 2220 | ||
| 1631 | if not FImage.FMemoryImage then |
2221 | if not FImage.FMemoryImage then |
| 1632 | GDIFlush; |
2222 | GDIFlush; |
| 1633 | Result := Pointer(Integer(FTopPBits)+Y*FNextLine); |
2223 | Result := Pointer(Integer(FTopPBits) + Y * FNextLine); |
| 1634 | end; |
2224 | end; |
| 1635 | 2225 | ||
| 1636 | function TDIB.GetScanLineReadOnly(Y: Integer): Pointer; |
2226 | function TDIB.GetScanLineReadOnly(Y: Integer): Pointer; |
| 1637 | begin |
2227 | begin |
| 1638 | if (Y<0) or (Y>=FHeight) then |
2228 | if (Y < 0) or (Y >= FHeight) then |
| 1639 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
2229 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
| 1640 | 2230 | ||
| 1641 | if not FImage.FMemoryImage then |
2231 | if not FImage.FMemoryImage then |
| 1642 | GDIFlush; |
2232 | GDIFlush; |
| 1643 | Result := Pointer(Integer(FTopPBits)+Y*FNextLine); |
2233 | Result := Pointer(Integer(FTopPBits) + Y * FNextLine); |
| 1644 | end; |
2234 | end; |
| 1645 | 2235 | ||
| 1646 | function TDIB.GetTopPBits: Pointer; |
2236 | function TDIB.GetTopPBits: Pointer; |
| 1647 | begin |
2237 | begin |
| 1648 | Changing(True); |
2238 | Changing(True); |
| Line 1655... | Line 2245... | ||
| 1655 | function TDIB.GetTopPBitsReadOnly: Pointer; |
2245 | function TDIB.GetTopPBitsReadOnly: Pointer; |
| 1656 | begin |
2246 | begin |
| 1657 | if not FImage.FMemoryImage then |
2247 | if not FImage.FMemoryImage then |
| 1658 | GDIFlush; |
2248 | GDIFlush; |
| 1659 | Result := FTopPBits; |
2249 | Result := FTopPBits; |
| 1660 | end; |
2250 | end; |
| 1661 | 2251 | ||
| 1662 | function TDIB.GetWidth: Integer; |
2252 | function TDIB.GetWidth: Integer; |
| 1663 | begin |
2253 | begin |
| 1664 | Result := FWidth; |
2254 | Result := FWidth; |
| 1665 | end; |
2255 | end; |
| Line 1677... | Line 2267... | ||
| 1677 | function TDIB.GetPixel(X, Y: Integer): DWORD; |
2267 | function TDIB.GetPixel(X, Y: Integer): DWORD; |
| 1678 | begin |
2268 | begin |
| 1679 | Decompress; |
2269 | Decompress; |
| 1680 | 2270 | ||
| 1681 | Result := 0; |
2271 | Result := 0; |
| 1682 | if (X>=0) and (X<FWidth) and (Y>=0) and (Y<FHeight) then |
2272 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then |
| 1683 | begin |
2273 | begin |
| 1684 | case FBitCount of |
2274 | case FBitCount of |
| 1685 | 1 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
2275 | 1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
| 1686 | 4 : Result := (PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
2276 | 4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]); |
| 1687 | 8 : Result := PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X]; |
2277 | 8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X]; |
| 1688 | 16: Result := PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X]; |
2278 | 16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X]; |
| 1689 | 24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do |
2279 | 24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do |
| 1690 | Result := R or (G shl 8) or (B shl 16); |
2280 | Result := R or (G shl 8) or (B shl 16); |
| 1691 | 32: Result := PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X]; |
2281 | 32: Result := PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X]; |
| 1692 | end; |
2282 | end; |
| 1693 | end; |
2283 | end; |
| 1694 | end; |
2284 | end; |
| 1695 | 2285 | ||
| - | 2286 | function TDIB.GetRGBChannel: TDIB; |
|
| - | 2287 | {Store RGB channel information into DIB24} |
|
| - | 2288 | begin |
|
| - | 2289 | Result := nil; |
|
| - | 2290 | if Self.Empty then Exit; |
|
| - | 2291 | Result := TDIB.Create; |
|
| - | 2292 | Result.SetSize(Width, Height, 24); |
|
| - | 2293 | Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0); |
|
| - | 2294 | FFreeList.Add(Result); |
|
| - | 2295 | end; |
|
| - | 2296 | ||
| 1696 | procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD); |
2297 | procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD); |
| 1697 | var |
2298 | var |
| 1698 | P: PByte; |
2299 | P: PByte; |
| 1699 | begin |
2300 | begin |
| 1700 | Changing(True); |
2301 | Changing(True); |
| 1701 | 2302 | ||
| 1702 | if (X>=0) and (X<FWidth) and (Y>=0) and (Y<FHeight) then |
2303 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then |
| 1703 | begin |
2304 | begin |
| 1704 | case FBitCount of |
2305 | case FBitCount of |
| 1705 | 1 : begin |
2306 | 1: begin |
| 1706 | P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3]; |
2307 | P := @PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]; |
| 1707 | P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]); |
2308 | P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]); |
| 1708 | end; |
2309 | end; |
| 1709 | 4 : begin |
2310 | 4: begin |
| 1710 | P := @PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X shr 3]; |
2311 | P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]); |
| 1711 | P^ := (P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]); |
2312 | P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1])); |
| 1712 | end; |
2313 | end; |
| 1713 | 8 : PArrayByte(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
2314 | 8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
| 1714 | 16: PArrayWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
2315 | 16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
| 1715 | 24: with PArrayBGR(Integer(FTopPBits)+Y*FNextLine)[X] do |
2316 | 24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do |
| 1716 | begin |
2317 | begin |
| 1717 | B := Byte(Value shr 16); |
2318 | B := Byte(Value shr 16); |
| 1718 | G := Byte(Value shr 8); |
2319 | G := Byte(Value shr 8); |
| 1719 | R := Byte(Value); |
2320 | R := Byte(Value); |
| 1720 | end; |
2321 | end; |
| 1721 | 32: PArrayDWord(Integer(FTopPBits)+Y*FNextLine)[X] := Value; |
2322 | 32: PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
| 1722 | end; |
2323 | end; |
| 1723 | end; |
2324 | end; |
| 1724 | end; |
2325 | end; |
| - | 2326 | ||
| - | 2327 | procedure TDIB.SetRGBChannel(const Value: TDIB); |
|
| - | 2328 | var |
|
| - | 2329 | alpha: TDIB; |
|
| - | 2330 | begin |
|
| - | 2331 | if Self.HasAlphaChannel then |
|
| - | 2332 | try |
|
| 1725 | 2333 | RetAlphaChannel(alpha); |
|
| - | 2334 | Self.SetSize(Value.Width, Value.Height, 32); |
|
| - | 2335 | Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0); |
|
| - | 2336 | Self.AssignAlphaChannel(alpha, True); |
|
| - | 2337 | finally |
|
| - | 2338 | alpha.Free; |
|
| - | 2339 | end |
|
| - | 2340 | else |
|
| - | 2341 | Self.Assign(Value); |
|
| - | 2342 | end; |
|
| - | 2343 | ||
| 1726 | procedure TDIB.DefineProperties(Filer: TFiler); |
2344 | procedure TDIB.DefineProperties(Filer: TFiler); |
| 1727 | begin |
2345 | begin |
| 1728 | inherited DefineProperties(Filer); |
2346 | inherited DefineProperties(Filer); |
| 1729 | { For interchangeability with an old version. } |
2347 | { For interchangeability with an old version. } |
| 1730 | Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False); |
2348 | Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False); |
| 1731 | end; |
2349 | end; |
| 1732 | 2350 | ||
| 1733 | type |
2351 | type |
| - | 2352 | { TGlobalMemoryStream } |
|
| - | 2353 | ||
| 1734 | TGlobalMemoryStream = class(TMemoryStream) |
2354 | TGlobalMemoryStream = class(TMemoryStream) |
| 1735 | private |
2355 | private |
| 1736 | FHandle: THandle; |
2356 | FHandle: THandle; |
| 1737 | public |
2357 | public |
| 1738 | constructor Create(AHandle: THandle); |
2358 | constructor Create(AHandle: THandle); |
| Line 1765... | Line 2385... | ||
| 1765 | Stream.Free; |
2385 | Stream.Free; |
| 1766 | end; |
2386 | end; |
| 1767 | end; |
2387 | end; |
| 1768 | 2388 | ||
| 1769 | const |
2389 | const |
| 1770 | BitmapFileType = Ord('B') + Ord('M')*$100; |
2390 | BitmapFileType = Ord('B') + Ord('M') * $100; |
| 1771 | 2391 | ||
| 1772 | procedure TDIB.LoadFromStream(Stream: TStream); |
2392 | procedure TDIB.LoadFromStream(Stream: TStream); |
| 1773 | var |
2393 | var |
| 1774 | BF: TBitmapFileHeader; |
2394 | BF: TBitmapFileHeader; |
| 1775 | i: Integer; |
2395 | i: Integer; |
| - | 2396 | ImageJPEG: TJPEGImage; |
|
| 1776 | begin |
2397 | begin |
| 1777 | { File header reading } |
2398 | { File header reading } |
| 1778 | i := Stream.Read(BF, SizeOf(TBitmapFileHeader)); |
2399 | i := Stream.Read(BF, SizeOf(TBitmapFileHeader)); |
| 1779 | if i=0 then Exit; |
2400 | if i = 0 then Exit; |
| 1780 | if i<>SizeOf(TBitmapFileHeader) then |
2401 | if i <> SizeOf(TBitmapFileHeader) then |
| 1781 | raise EInvalidGraphic.Create(SInvalidDIB); |
2402 | raise EInvalidGraphic.Create(SInvalidDIB); |
| 1782 | 2403 | ||
| - | 2404 | { Is the head jpeg ?} |
|
| - | 2405 | ||
| - | 2406 | if BF.bfType = $D8FF then |
|
| - | 2407 | begin |
|
| - | 2408 | ImageJPEG := TJPEGImage.Create; |
|
| - | 2409 | try |
|
| - | 2410 | try |
|
| - | 2411 | Stream.Position := 0; |
|
| - | 2412 | ImageJPEG.LoadFromStream(Stream); |
|
| - | 2413 | except |
|
| - | 2414 | on EInvalidGraphic do ImageJPEG := nil; |
|
| - | 2415 | end; |
|
| - | 2416 | if ImageJPEG <> nil then |
|
| - | 2417 | begin |
|
| - | 2418 | {set size and bitcount in natural units of jpeg} |
|
| - | 2419 | SetSize(ImageJPEG.Width, ImageJPEG.Height, 24); |
|
| - | 2420 | Canvas.Draw(0, 0, ImageJPEG); |
|
| - | 2421 | Exit |
|
| - | 2422 | end; |
|
| - | 2423 | finally |
|
| - | 2424 | ImageJPEG.Free; |
|
| - | 2425 | end; |
|
| - | 2426 | end |
|
| - | 2427 | else |
|
| 1783 | { Is the head 'BM'? } |
2428 | { Is the head 'BM'? } |
| 1784 | if BF.bfType<>BitmapFileType then |
2429 | if BF.bfType <> BitmapFileType then |
| 1785 | raise EInvalidGraphic.Create(SInvalidDIB); |
2430 | raise EInvalidGraphic.Create(SInvalidDIB); |
| 1786 | 2431 | ||
| 1787 | ReadData(Stream); |
2432 | ReadData(Stream); |
| 1788 | end; |
2433 | end; |
| 1789 | 2434 | ||
| 1790 | procedure TDIB.ReadData(Stream: TStream); |
2435 | procedure TDIB.ReadData(Stream: TStream); |
| Line 1813... | Line 2458... | ||
| 1813 | Stream := TMemoryStream.Create; |
2458 | Stream := TMemoryStream.Create; |
| 1814 | try |
2459 | try |
| 1815 | WriteData(Stream); |
2460 | WriteData(Stream); |
| 1816 | 2461 | ||
| 1817 | AData := GlobalAlloc(GHND, Stream.Size); |
2462 | AData := GlobalAlloc(GHND, Stream.Size); |
| 1818 | if AData=0 then OutOfMemoryError; |
2463 | if AData = 0 then OutOfMemoryError; |
| 1819 | 2464 | ||
| 1820 | P := GlobalLock(AData); |
2465 | P := GlobalLock(AData); |
| 1821 | Move(Stream.Memory^, P^, Stream.Size); |
2466 | Move(Stream.Memory^, P^, Stream.Size); |
| 1822 | GlobalUnLock(AData); |
2467 | GlobalUnLock(AData); |
| 1823 | finally |
2468 | finally |
| Line 1831... | Line 2476... | ||
| 1831 | begin |
2476 | begin |
| 1832 | if Empty then Exit; |
2477 | if Empty then Exit; |
| 1833 | 2478 | ||
| 1834 | with BF do |
2479 | with BF do |
| 1835 | begin |
2480 | begin |
| 1836 | bfType := BitmapFileType; |
2481 | bfType := BitmapFileType; |
| 1837 | bfOffBits := SizeOf(TBitmapFileHeader)+BitmapInfoSize; |
2482 | bfOffBits := SizeOf(TBitmapFileHeader) + BitmapInfoSize; |
| 1838 | bfSize := bfOffBits+FImage.FBitmapInfo^.bmiHeader.biSizeImage; |
2483 | bfSize := bfOffBits + FImage.FBitmapInfo^.bmiHeader.biSizeImage; |
| 1839 | bfReserved1 := 0; |
2484 | bfReserved1 := 0; |
| 1840 | bfReserved2 := 0; |
2485 | bfReserved2 := 0; |
| 1841 | end; |
2486 | end; |
| 1842 | Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader)); |
2487 | Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader)); |
| 1843 | 2488 | ||
| Line 1855... | Line 2500... | ||
| 1855 | Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage); |
2500 | Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage); |
| 1856 | end; |
2501 | end; |
| 1857 | 2502 | ||
| 1858 | procedure TDIB.SetBitCount(Value: Integer); |
2503 | procedure TDIB.SetBitCount(Value: Integer); |
| 1859 | begin |
2504 | begin |
| 1860 | if Value<=0 then |
2505 | if Value <= 0 then |
| 1861 | Clear |
2506 | Clear |
| 1862 | else |
2507 | else |
| 1863 | begin |
2508 | begin |
| 1864 | if Empty then |
2509 | if Empty then |
| 1865 | begin |
2510 | begin |
| 1866 | SetSize(Max(Width, 1), Max(Height, 1), Value) |
2511 | SetSize(Max(Width, 1), Max(Height, 1), Value) |
| - | 2512 | end |
|
| 1867 | end else |
2513 | else |
| 1868 | begin |
2514 | begin |
| 1869 | ConvertBitCount(Value); |
2515 | ConvertBitCount(Value); |
| 1870 | end; |
2516 | end; |
| 1871 | end; |
2517 | end; |
| 1872 | end; |
2518 | end; |
| 1873 | 2519 | ||
| 1874 | procedure TDIB.SetHeight(Value: Integer); |
2520 | procedure TDIB.SetHeight(Value: Integer); |
| 1875 | begin |
2521 | begin |
| 1876 | if Value<=0 then |
2522 | if Value <= 0 then |
| 1877 | Clear |
2523 | Clear |
| 1878 | else |
2524 | else |
| 1879 | begin |
2525 | begin |
| 1880 | if Empty then |
2526 | if Empty then |
| 1881 | SetSize(Max(Width, 1), Value, 8) |
2527 | SetSize(Max(Width, 1), Value, 8) |
| Line 1884... | Line 2530... | ||
| 1884 | end; |
2530 | end; |
| 1885 | end; |
2531 | end; |
| 1886 | 2532 | ||
| 1887 | procedure TDIB.SetWidth(Value: Integer); |
2533 | procedure TDIB.SetWidth(Value: Integer); |
| 1888 | begin |
2534 | begin |
| 1889 | if Value<=0 then |
2535 | if Value <= 0 then |
| 1890 | Clear |
2536 | Clear |
| 1891 | else |
2537 | else |
| 1892 | begin |
2538 | begin |
| 1893 | if Empty then |
2539 | if Empty then |
| 1894 | SetSize(Value, Max(Height, 1), 8) |
2540 | SetSize(Value, Max(Height, 1), 8) |
| Line 1897... | Line 2543... | ||
| 1897 | end; |
2543 | end; |
| 1898 | end; |
2544 | end; |
| 1899 | 2545 | ||
| 1900 | procedure TDIB.SetImage(Value: TDIBSharedImage); |
2546 | procedure TDIB.SetImage(Value: TDIBSharedImage); |
| 1901 | begin |
2547 | begin |
| 1902 | if FImage<>Value then |
2548 | if FImage <> Value then |
| 1903 | begin |
2549 | begin |
| 1904 | if FCanvas<>nil then |
2550 | if FCanvas <> nil then |
| 1905 | FCanvas.Handle := 0; |
2551 | FCanvas.Handle := 0; |
| 1906 | 2552 | ||
| 1907 | FImage.Release; |
2553 | FImage.Release; |
| 1908 | FImage := Value; |
2554 | FImage := Value; |
| 1909 | FImage.Reference; |
2555 | FImage.Reference; |
| 1910 | 2556 | ||
| 1911 | if FCanvas<>nil then |
2557 | if FCanvas <> nil then |
| 1912 | FCanvas.Handle := FImage.FDC; |
2558 | FCanvas.Handle := FImage.FDC; |
| 1913 | 2559 | ||
| 1914 | ColorTable := FImage.FColorTable; |
2560 | ColorTable := FImage.FColorTable; |
| 1915 | PixelFormat := FImage.FPixelFormat; |
2561 | PixelFormat := FImage.FPixelFormat; |
| 1916 | 2562 | ||
| Line 1957... | Line 2603... | ||
| 1957 | 2603 | ||
| 1958 | procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer); |
2604 | procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer); |
| 1959 | var |
2605 | var |
| 1960 | TempImage: TDIBSharedImage; |
2606 | TempImage: TDIBSharedImage; |
| 1961 | begin |
2607 | begin |
| 1962 | if (AWidth=Width) and (AHeight=Height) and (ABitCount=BitCount) and |
2608 | if (AWidth = Width) and (AHeight = Height) and (ABitCount = BitCount) and |
| 1963 | (NowPixelFormat.RBitMask=PixelFormat.RBitMask) and |
2609 | (NowPixelFormat.RBitMask = PixelFormat.RBitMask) and |
| 1964 | (NowPixelFormat.GBitMask=PixelFormat.GBitMask) and |
2610 | (NowPixelFormat.GBitMask = PixelFormat.GBitMask) and |
| 1965 | (NowPixelFormat.BBitMask=PixelFormat.BBitMask) then Exit; |
2611 | (NowPixelFormat.BBitMask = PixelFormat.BBitMask) then Exit; |
| 1966 | 2612 | ||
| 1967 | if (AWidth<=0) or (AHeight<=0) then |
2613 | if (AWidth <= 0) or (AHeight <= 0) then |
| 1968 | begin |
2614 | begin |
| 1969 | Clear; |
2615 | Clear; |
| 1970 | Exit; |
2616 | Exit; |
| 1971 | end; |
2617 | end; |
| 1972 | 2618 | ||
| Line 2003... | Line 2649... | ||
| 2003 | 2649 | ||
| 2004 | procedure CreateHalftonePalette(R, G, B: Integer); |
2650 | procedure CreateHalftonePalette(R, G, B: Integer); |
| 2005 | var |
2651 | var |
| 2006 | i: Integer; |
2652 | i: Integer; |
| 2007 | begin |
2653 | begin |
| 2008 | for i:=0 to 255 do |
2654 | for i := 0 to 255 do |
| 2009 | with ColorTable[i] do |
2655 | with ColorTable[i] do |
| 2010 | begin |
2656 | begin |
| 2011 | rgbRed := ((i shr (G+B-1)) and (1 shl R-1)) * 255 div (1 shl R-1); |
2657 | rgbRed := ((i shr (G + B - 1)) and (1 shl R - 1)) * 255 div (1 shl R - 1); |
| 2012 | rgbGreen := ((i shr (B-1)) and (1 shl G-1)) * 255 div (1 shl G-1); |
2658 | rgbGreen := ((i shr (B - 1)) and (1 shl G - 1)) * 255 div (1 shl G - 1); |
| 2013 | rgbBlue := ((i shr 0) and (1 shl B-1)) * 255 div (1 shl B-1); |
2659 | rgbBlue := ((i shr 0) and (1 shl B - 1)) * 255 div (1 shl B - 1); |
| 2014 | end; |
2660 | end; |
| 2015 | end; |
2661 | end; |
| 2016 | 2662 | ||
| 2017 | procedure PaletteToPalette_Inc; |
2663 | procedure PaletteToPalette_Inc; |
| 2018 | var |
2664 | var |
| Line 2021... | Line 2667... | ||
| 2021 | SrcP, DestP: Pointer; |
2667 | SrcP, DestP: Pointer; |
| 2022 | P: PByte; |
2668 | P: PByte; |
| 2023 | begin |
2669 | begin |
| 2024 | i := 0; |
2670 | i := 0; |
| 2025 | 2671 | ||
| 2026 | for y:=0 to Height-1 do |
2672 | for y := 0 to Height - 1 do |
| 2027 | begin |
2673 | begin |
| 2028 | SrcP := Temp.ScanLine[y]; |
2674 | SrcP := Temp.ScanLine[y]; |
| 2029 | DestP := ScanLine[y]; |
2675 | DestP := ScanLine[y]; |
| 2030 | 2676 | ||
| 2031 | for x:=0 to Width-1 do |
2677 | for x := 0 to Width - 1 do |
| 2032 | begin |
2678 | begin |
| 2033 | case Temp.BitCount of |
2679 | case Temp.BitCount of |
| - | 2680 | 1: |
|
| 2034 | 1 : begin |
2681 | begin |
| 2035 | i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
2682 | i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
| 2036 | end; |
2683 | end; |
| - | 2684 | 4: |
|
| 2037 | 4 : begin |
2685 | begin |
| 2038 | i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
2686 | i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
| 2039 | end; |
2687 | end; |
| - | 2688 | 8: |
|
| 2040 | 8 : begin |
2689 | begin |
| 2041 | i := PByte(SrcP)^; |
2690 | i := PByte(SrcP)^; |
| 2042 | Inc(PByte(SrcP)); |
2691 | Inc(PByte(SrcP)); |
| 2043 | end; |
2692 | end; |
| 2044 | end; |
2693 | end; |
| 2045 | 2694 | ||
| 2046 | case BitCount of |
2695 | case BitCount of |
| - | 2696 | 1: |
|
| 2047 | 1 : begin |
2697 | begin |
| 2048 | P := @PArrayByte(DestP)[X shr 3]; |
2698 | P := @PArrayByte(DestP)[X shr 3]; |
| 2049 | P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]); |
2699 | P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]); |
| 2050 | end; |
2700 | end; |
| - | 2701 | 4: |
|
| 2051 | 4 : begin |
2702 | begin |
| 2052 | P := @PArrayByte(DestP)[X shr 1]; |
2703 | P := @PArrayByte(DestP)[X shr 1]; |
| 2053 | P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]); |
2704 | P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]); |
| 2054 | end; |
2705 | end; |
| - | 2706 | 8: |
|
| 2055 | 8 : begin |
2707 | begin |
| 2056 | PByte(DestP)^ := i; |
2708 | PByte(DestP)^ := i; |
| 2057 | Inc(PByte(DestP)); |
2709 | Inc(PByte(DestP)); |
| 2058 | end; |
2710 | end; |
| 2059 | end; |
2711 | end; |
| 2060 | end; |
2712 | end; |
| 2061 | end; |
2713 | end; |
| 2062 | end; |
2714 | end; |
| 2063 | 2715 | ||
| Line 2069... | Line 2721... | ||
| 2069 | begin |
2721 | begin |
| 2070 | cR := 0; |
2722 | cR := 0; |
| 2071 | cG := 0; |
2723 | cG := 0; |
| 2072 | cB := 0; |
2724 | cB := 0; |
| 2073 | 2725 | ||
| 2074 | for y:=0 to Height-1 do |
2726 | for y := 0 to Height - 1 do |
| 2075 | begin |
2727 | begin |
| 2076 | SrcP := Temp.ScanLine[y]; |
2728 | SrcP := Temp.ScanLine[y]; |
| 2077 | DestP := ScanLine[y]; |
2729 | DestP := ScanLine[y]; |
| 2078 | 2730 | ||
| 2079 | for x:=0 to Width-1 do |
2731 | for x := 0 to Width - 1 do |
| 2080 | begin |
2732 | begin |
| 2081 | case Temp.BitCount of |
2733 | case Temp.BitCount of |
| - | 2734 | 1: |
|
| 2082 | 1 : begin |
2735 | begin |
| 2083 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
2736 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
| 2084 | begin |
2737 | begin |
| 2085 | cR := rgbRed; |
2738 | cR := rgbRed; |
| 2086 | cG := rgbGreen; |
2739 | cG := rgbGreen; |
| 2087 | cB := rgbBlue; |
2740 | cB := rgbBlue; |
| 2088 | end; |
- | |
| 2089 | end; |
2741 | end; |
| - | 2742 | end; |
|
| - | 2743 | 4: |
|
| 2090 | 4 : begin |
2744 | begin |
| 2091 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
2745 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
| 2092 | begin |
2746 | begin |
| 2093 | cR := rgbRed; |
2747 | cR := rgbRed; |
| 2094 | cG := rgbGreen; |
2748 | cG := rgbGreen; |
| 2095 | cB := rgbBlue; |
2749 | cB := rgbBlue; |
| 2096 | end; |
- | |
| 2097 | end; |
2750 | end; |
| - | 2751 | end; |
|
| - | 2752 | 8: |
|
| 2098 | 8 : begin |
2753 | begin |
| 2099 | with Temp.ColorTable[PByte(SrcP)^] do |
2754 | with Temp.ColorTable[PByte(SrcP)^] do |
| 2100 | begin |
2755 | begin |
| 2101 | cR := rgbRed; |
2756 | cR := rgbRed; |
| 2102 | cG := rgbGreen; |
2757 | cG := rgbGreen; |
| 2103 | cB := rgbBlue; |
2758 | cB := rgbBlue; |
| 2104 | end; |
- | |
| 2105 | Inc(PByte(SrcP)); |
- | |
| 2106 | end; |
2759 | end; |
| - | 2760 | Inc(PByte(SrcP)); |
|
| - | 2761 | end; |
|
| - | 2762 | 16: |
|
| 2107 | 16: begin |
2763 | begin |
| 2108 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB); |
2764 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB); |
| 2109 | Inc(PWord(SrcP)); |
2765 | Inc(PWord(SrcP)); |
| - | 2766 | end; |
|
| - | 2767 | 24: |
|
| - | 2768 | begin |
|
| - | 2769 | with PBGR(SrcP)^ do |
|
| - | 2770 | begin |
|
| - | 2771 | cR := R; |
|
| - | 2772 | cG := G; |
|
| - | 2773 | cB := B; |
|
| 2110 | end; |
2774 | end; |
| 2111 | 24: begin |
- | |
| 2112 | with PBGR(SrcP)^ do |
- | |
| 2113 | begin |
- | |
| 2114 | cR := R; |
- | |
| 2115 | cG := G; |
- | |
| 2116 | cB := B; |
- | |
| 2117 | end; |
- | |
| 2118 | 2775 | ||
| 2119 | Inc(PBGR(SrcP)); |
2776 | Inc(PBGR(SrcP)); |
| 2120 | end; |
2777 | end; |
| - | 2778 | 32: |
|
| 2121 | 32: begin |
2779 | begin |
| 2122 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB); |
2780 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB); |
| 2123 | Inc(PDWORD(SrcP)); |
2781 | Inc(PDWORD(SrcP)); |
| 2124 | end; |
2782 | end; |
| 2125 | end; |
2783 | end; |
| 2126 | 2784 | ||
| 2127 | case BitCount of |
2785 | case BitCount of |
| - | 2786 | 16: |
|
| 2128 | 16: begin |
2787 | begin |
| 2129 | PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
2788 | PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
| 2130 | Inc(PWord(DestP)); |
2789 | Inc(PWord(DestP)); |
| 2131 | end; |
2790 | end; |
| - | 2791 | 24: |
|
| 2132 | 24: begin |
2792 | begin |
| 2133 | with PBGR(DestP)^ do |
2793 | with PBGR(DestP)^ do |
| 2134 | begin |
2794 | begin |
| 2135 | R := cR; |
2795 | R := cR; |
| 2136 | G := cG; |
2796 | G := cG; |
| 2137 | B := cB; |
2797 | B := cB; |
| 2138 | end; |
- | |
| 2139 | Inc(PBGR(DestP)); |
- | |
| 2140 | end; |
- | |
| 2141 | 32: begin |
- | |
| 2142 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
- | |
| 2143 | Inc(PDWORD(DestP)); |
- | |
| 2144 | end; |
2798 | end; |
| - | 2799 | Inc(PBGR(DestP)); |
|
| - | 2800 | end; |
|
| - | 2801 | 32: |
|
| - | 2802 | begin |
|
| - | 2803 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
|
| - | 2804 | Inc(PDWORD(DestP)); |
|
| - | 2805 | end; |
|
| 2145 | end; |
2806 | end; |
| 2146 | end; |
2807 | end; |
| 2147 | end; |
2808 | end; |
| 2148 | end; |
2809 | end; |
| 2149 | 2810 | ||
| 2150 | begin |
2811 | begin |
| 2151 | if Size=0 then exit; |
2812 | if Size = 0 then exit; |
| 2152 | 2813 | ||
| 2153 | Temp := TDIB.Create; |
2814 | Temp := TDIB.Create; |
| 2154 | try |
2815 | try |
| 2155 | Temp.Assign(Self); |
2816 | Temp.Assign(Self); |
| 2156 | SetSize(Temp.Width, Temp.Height, ABitCount); |
2817 | SetSize(Temp.Width, Temp.Height, ABitCount); |
| 2157 | 2818 | ||
| 2158 | if FImage=Temp.FImage then Exit; |
2819 | if FImage = Temp.FImage then Exit; |
| 2159 | 2820 | ||
| 2160 | if (Temp.BitCount<=8) and (BitCount<=8) then |
2821 | if (Temp.BitCount <= 8) and (BitCount <= 8) then |
| 2161 | begin |
2822 | begin |
| 2162 | { The image is converted from the palette color image into the palette color image. } |
2823 | { The image is converted from the palette color image into the palette color image. } |
| 2163 | if Temp.BitCount<=BitCount then |
2824 | if Temp.BitCount <= BitCount then |
| 2164 | begin |
2825 | begin |
| 2165 | PaletteToPalette_Inc; |
2826 | PaletteToPalette_Inc; |
| - | 2827 | end |
|
| 2166 | end else |
2828 | else |
| 2167 | begin |
2829 | begin |
| 2168 | case BitCount of |
2830 | case BitCount of |
| 2169 | 1: begin |
2831 | 1: begin |
| 2170 | ColorTable[0] := RGBQuad(0, 0, 0); |
2832 | ColorTable[0] := RGBQuad(0, 0, 0); |
| 2171 | ColorTable[1] := RGBQuad(255, 255, 255); |
2833 | ColorTable[1] := RGBQuad(255, 255, 255); |
| 2172 | end; |
2834 | end; |
| 2173 | 4: CreateHalftonePalette(1, 2, 1); |
2835 | 4: CreateHalftonePalette(1, 2, 1); |
| 2174 | 8: CreateHalftonePalette(3, 3, 2); |
2836 | 8: CreateHalftonePalette(3, 3, 2); |
| 2175 | end; |
2837 | end; |
| 2176 | UpdatePalette; |
2838 | UpdatePalette; |
| 2177 | 2839 | ||
| 2178 | Canvas.Draw(0, 0, Temp); |
2840 | Canvas.Draw(0, 0, Temp); |
| 2179 | end; |
2841 | end; |
| - | 2842 | end |
|
| 2180 | end else |
2843 | else |
| 2181 | if (Temp.BitCount<=8) and (BitCount>8) then |
2844 | if (Temp.BitCount <= 8) and (BitCount > 8) then |
| 2182 | begin |
2845 | begin |
| 2183 | { The image is converted from the palette color image into the rgb color image. } |
2846 | { The image is converted from the palette color image into the rgb color image. } |
| 2184 | PaletteToRGB_or_RGBToRGB; |
2847 | PaletteToRGB_or_RGBToRGB; |
| - | 2848 | end |
|
| 2185 | end else |
2849 | else |
| 2186 | if (Temp.BitCount>8) and (BitCount<=8) then |
2850 | if (Temp.BitCount > 8) and (BitCount <= 8) then |
| 2187 | begin |
2851 | begin |
| 2188 | { The image is converted from the rgb color image into the palette color image. } |
2852 | { The image is converted from the rgb color image into the palette color image. } |
| 2189 | case BitCount of |
2853 | case BitCount of |
| 2190 | 1: begin |
2854 | 1: begin |
| 2191 | ColorTable[0] := RGBQuad(0, 0, 0); |
2855 | ColorTable[0] := RGBQuad(0, 0, 0); |
| 2192 | ColorTable[1] := RGBQuad(255, 255, 255); |
2856 | ColorTable[1] := RGBQuad(255, 255, 255); |
| 2193 | end; |
2857 | end; |
| 2194 | 4: CreateHalftonePalette(1, 2, 1); |
2858 | 4: CreateHalftonePalette(1, 2, 1); |
| 2195 | 8: CreateHalftonePalette(3, 3, 2); |
2859 | 8: CreateHalftonePalette(3, 3, 2); |
| 2196 | end; |
2860 | end; |
| 2197 | UpdatePalette; |
2861 | UpdatePalette; |
| 2198 | 2862 | ||
| 2199 | Canvas.Draw(0, 0, Temp); |
2863 | Canvas.Draw(0, 0, Temp); |
| - | 2864 | end |
|
| 2200 | end else |
2865 | else |
| 2201 | if (Temp.BitCount>8) and (BitCount>8) then |
2866 | if (Temp.BitCount > 8) and (BitCount > 8) then |
| 2202 | begin |
2867 | begin |
| 2203 | { The image is converted from the rgb color image into the rgb color image. } |
2868 | { The image is converted from the rgb color image into the rgb color image. } |
| 2204 | PaletteToRGB_or_RGBToRGB; |
2869 | PaletteToRGB_or_RGBToRGB; |
| 2205 | end; |
2870 | end; |
| 2206 | finally |
2871 | finally |
| 2207 | Temp.Free; |
2872 | Temp.Free; |
| 2208 | end; |
2873 | end; |
| 2209 | end; |
2874 | end; |
| 2210 | 2875 | ||
| Line 2228... | Line 2893... | ||
| 2228 | procedure TDIB.UpdateProgress(PercentY: Integer); |
2893 | procedure TDIB.UpdateProgress(PercentY: Integer); |
| 2229 | var |
2894 | var |
| 2230 | Redraw: Boolean; |
2895 | Redraw: Boolean; |
| 2231 | Percent: DWORD; |
2896 | Percent: DWORD; |
| 2232 | begin |
2897 | begin |
| 2233 | Redraw := (GetTickCount-FProgressOldTime>200) and (FProgressY-FProgressOldY>32) and |
2898 | Redraw := (GetTickCount - FProgressOldTime > 200) and (FProgressY - FProgressOldY > 32) and |
| 2234 | (((Height div 3>Integer(FProgressY)) and (FProgressOldY=0)) or (FProgressOldY<>0)); |
2899 | (((Height div 3 > Integer(FProgressY)) and (FProgressOldY = 0)) or (FProgressOldY <> 0)); |
| 2235 | 2900 | ||
| 2236 | Percent := PercentY*100 div Height; |
2901 | Percent := PercentY * 100 div Height; |
| 2237 | 2902 | ||
| 2238 | if (Percent<>FProgressOld) or (Redraw) then |
2903 | if (Percent <> FProgressOld) or (Redraw) then |
| 2239 | begin |
2904 | begin |
| 2240 | Progress(Self, psRunning, Percent, Redraw, |
2905 | Progress(Self, psRunning, Percent, Redraw, |
| 2241 | Rect(0, FProgressOldY, Width, FProgressY), FProgressName); |
2906 | Rect(0, FProgressOldY, Width, FProgressY), FProgressName); |
| 2242 | if Redraw then |
2907 | if Redraw then |
| 2243 | begin |
2908 | begin |
| Line 2249... | Line 2914... | ||
| 2249 | end; |
2914 | end; |
| 2250 | 2915 | ||
| 2251 | Inc(FProgressY); |
2916 | Inc(FProgressY); |
| 2252 | end; |
2917 | end; |
| 2253 | 2918 | ||
| - | 2919 | procedure TDIB.Mirror(MirrorX, MirrorY: Boolean); |
|
| - | 2920 | var |
|
| - | 2921 | x, y, Width2, c: Integer; |
|
| - | 2922 | P1, P2, TempBuf: Pointer; |
|
| - | 2923 | begin |
|
| - | 2924 | if Empty then Exit; |
|
| - | 2925 | if (not MirrorX) and (not MirrorY) then Exit; |
|
| - | 2926 | ||
| - | 2927 | if (not MirrorX) and (MirrorY) then |
|
| - | 2928 | begin |
|
| - | 2929 | GetMem(TempBuf, WidthBytes); |
|
| - | 2930 | try |
|
| - | 2931 | StartProgress('Mirror'); |
|
| - | 2932 | try |
|
| - | 2933 | for y := 0 to Height shr 1 - 1 do |
|
| - | 2934 | begin |
|
| - | 2935 | P1 := ScanLine[y]; |
|
| - | 2936 | P2 := ScanLine[Height - y - 1]; |
|
| - | 2937 | ||
| - | 2938 | Move(P1^, TempBuf^, WidthBytes); |
|
| - | 2939 | Move(P2^, P1^, WidthBytes); |
|
| - | 2940 | Move(TempBuf^, P2^, WidthBytes); |
|
| - | 2941 | ||
| - | 2942 | UpdateProgress(y * 2); |
|
| - | 2943 | end; |
|
| - | 2944 | finally |
|
| - | 2945 | EndProgress; |
|
| - | 2946 | end; |
|
| - | 2947 | finally |
|
| - | 2948 | FreeMem(TempBuf, WidthBytes); |
|
| - | 2949 | end; |
|
| - | 2950 | end |
|
| - | 2951 | else |
|
| - | 2952 | if (MirrorX) and (not MirrorY) then |
|
| - | 2953 | begin |
|
| - | 2954 | Width2 := Width shr 1; |
|
| - | 2955 | ||
| - | 2956 | StartProgress('Mirror'); |
|
| - | 2957 | try |
|
| - | 2958 | for y := 0 to Height - 1 do |
|
| - | 2959 | begin |
|
| - | 2960 | P1 := ScanLine[y]; |
|
| - | 2961 | ||
| - | 2962 | case BitCount of |
|
| - | 2963 | 1: |
|
| - | 2964 | begin |
|
| - | 2965 | for x := 0 to Width2 - 1 do |
|
| - | 2966 | begin |
|
| - | 2967 | c := Pixels[x, y]; |
|
| - | 2968 | Pixels[x, y] := Pixels[Width - x - 1, y]; |
|
| - | 2969 | Pixels[Width - x - 1, y] := c; |
|
| - | 2970 | end; |
|
| - | 2971 | end; |
|
| - | 2972 | 4: |
|
| - | 2973 | begin |
|
| - | 2974 | for x := 0 to Width2 - 1 do |
|
| - | 2975 | begin |
|
| - | 2976 | c := Pixels[x, y]; |
|
| - | 2977 | Pixels[x, y] := Pixels[Width - x - 1, y]; |
|
| - | 2978 | Pixels[Width - x - 1, y] := c; |
|
| - | 2979 | end; |
|
| - | 2980 | end; |
|
| - | 2981 | 8: |
|
| - | 2982 | begin |
|
| - | 2983 | P2 := Pointer(Integer(P1) + Width - 1); |
|
| - | 2984 | for x := 0 to Width2 - 1 do |
|
| - | 2985 | begin |
|
| - | 2986 | PByte(@c)^ := PByte(P1)^; |
|
| - | 2987 | PByte(P1)^ := PByte(P2)^; |
|
| - | 2988 | PByte(P2)^ := PByte(@c)^; |
|
| - | 2989 | Inc(PByte(P1)); |
|
| - | 2990 | Dec(PByte(P2)); |
|
| - | 2991 | end; |
|
| - | 2992 | end; |
|
| - | 2993 | 16: |
|
| - | 2994 | begin |
|
| - | 2995 | P2 := Pointer(Integer(P1) + (Width - 1) * 2); |
|
| - | 2996 | for x := 0 to Width2 - 1 do |
|
| - | 2997 | begin |
|
| - | 2998 | PWord(@c)^ := PWord(P1)^; |
|
| - | 2999 | PWord(P1)^ := PWord(P2)^; |
|
| - | 3000 | PWord(P2)^ := PWord(@c)^; |
|
| - | 3001 | Inc(PWord(P1)); |
|
| - | 3002 | Dec(PWord(P2)); |
|
| - | 3003 | end; |
|
| - | 3004 | end; |
|
| - | 3005 | 24: |
|
| - | 3006 | begin |
|
| - | 3007 | P2 := Pointer(Integer(P1) + (Width - 1) * 3); |
|
| - | 3008 | for x := 0 to Width2 - 1 do |
|
| - | 3009 | begin |
|
| - | 3010 | PBGR(@c)^ := PBGR(P1)^; |
|
| - | 3011 | PBGR(P1)^ := PBGR(P2)^; |
|
| - | 3012 | PBGR(P2)^ := PBGR(@c)^; |
|
| - | 3013 | Inc(PBGR(P1)); |
|
| - | 3014 | Dec(PBGR(P2)); |
|
| - | 3015 | end; |
|
| - | 3016 | end; |
|
| - | 3017 | 32: |
|
| - | 3018 | begin |
|
| - | 3019 | P2 := Pointer(Integer(P1) + (Width - 1) * 4); |
|
| - | 3020 | for x := 0 to Width2 - 1 do |
|
| - | 3021 | begin |
|
| - | 3022 | PDWORD(@c)^ := PDWORD(P1)^; |
|
| - | 3023 | PDWORD(P1)^ := PDWORD(P2)^; |
|
| - | 3024 | PDWORD(P2)^ := PDWORD(@c)^; |
|
| - | 3025 | Inc(PDWORD(P1)); |
|
| - | 3026 | Dec(PDWORD(P2)); |
|
| - | 3027 | end; |
|
| - | 3028 | end; |
|
| - | 3029 | end; |
|
| - | 3030 | ||
| - | 3031 | UpdateProgress(y); |
|
| - | 3032 | end; |
|
| - | 3033 | finally |
|
| - | 3034 | EndProgress; |
|
| - | 3035 | end; |
|
| - | 3036 | end |
|
| - | 3037 | else |
|
| - | 3038 | if (MirrorX) and (MirrorY) then |
|
| - | 3039 | begin |
|
| - | 3040 | StartProgress('Mirror'); |
|
| - | 3041 | try |
|
| - | 3042 | for y := 0 to Height shr 1 - 1 do |
|
| - | 3043 | begin |
|
| - | 3044 | P1 := ScanLine[y]; |
|
| - | 3045 | P2 := ScanLine[Height - y - 1]; |
|
| - | 3046 | ||
| - | 3047 | case BitCount of |
|
| - | 3048 | 1: |
|
| - | 3049 | begin |
|
| - | 3050 | for x := 0 to Width - 1 do |
|
| - | 3051 | begin |
|
| - | 3052 | c := Pixels[x, y]; |
|
| - | 3053 | Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1]; |
|
| - | 3054 | Pixels[Width - x - 1, Height - y - 1] := c; |
|
| - | 3055 | end; |
|
| - | 3056 | end; |
|
| - | 3057 | 4: |
|
| - | 3058 | begin |
|
| - | 3059 | for x := 0 to Width - 1 do |
|
| - | 3060 | begin |
|
| - | 3061 | c := Pixels[x, y]; |
|
| - | 3062 | Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1]; |
|
| - | 3063 | Pixels[Width - x - 1, Height - y - 1] := c; |
|
| - | 3064 | end; |
|
| - | 3065 | end; |
|
| - | 3066 | 8: |
|
| - | 3067 | begin |
|
| - | 3068 | P2 := Pointer(Integer(P2) + Width - 1); |
|
| - | 3069 | for x := 0 to Width - 1 do |
|
| - | 3070 | begin |
|
| - | 3071 | PByte(@c)^ := PByte(P1)^; |
|
| - | 3072 | PByte(P1)^ := PByte(P2)^; |
|
| - | 3073 | PByte(P2)^ := PByte(@c)^; |
|
| - | 3074 | Inc(PByte(P1)); |
|
| - | 3075 | Dec(PByte(P2)); |
|
| - | 3076 | end; |
|
| - | 3077 | end; |
|
| - | 3078 | 16: |
|
| - | 3079 | begin |
|
| - | 3080 | P2 := Pointer(Integer(P2) + (Width - 1) * 2); |
|
| - | 3081 | for x := 0 to Width - 1 do |
|
| - | 3082 | begin |
|
| - | 3083 | PWord(@c)^ := PWord(P1)^; |
|
| - | 3084 | PWord(P1)^ := PWord(P2)^; |
|
| - | 3085 | PWord(P2)^ := PWord(@c)^; |
|
| - | 3086 | Inc(PWord(P1)); |
|
| - | 3087 | Dec(PWord(P2)); |
|
| - | 3088 | end; |
|
| - | 3089 | end; |
|
| - | 3090 | 24: |
|
| - | 3091 | begin |
|
| - | 3092 | P2 := Pointer(Integer(P2) + (Width - 1) * 3); |
|
| - | 3093 | for x := 0 to Width - 1 do |
|
| - | 3094 | begin |
|
| - | 3095 | PBGR(@c)^ := PBGR(P1)^; |
|
| - | 3096 | PBGR(P1)^ := PBGR(P2)^; |
|
| - | 3097 | PBGR(P2)^ := PBGR(@c)^; |
|
| - | 3098 | Inc(PBGR(P1)); |
|
| - | 3099 | Dec(PBGR(P2)); |
|
| - | 3100 | end; |
|
| - | 3101 | end; |
|
| - | 3102 | 32: |
|
| - | 3103 | begin |
|
| - | 3104 | P2 := Pointer(Integer(P2) + (Width - 1) * 4); |
|
| - | 3105 | for x := 0 to Width - 1 do |
|
| - | 3106 | begin |
|
| - | 3107 | PDWORD(@c)^ := PDWORD(P1)^; |
|
| - | 3108 | PDWORD(P1)^ := PDWORD(P2)^; |
|
| - | 3109 | PDWORD(P2)^ := PDWORD(@c)^; |
|
| - | 3110 | Inc(PDWORD(P1)); |
|
| - | 3111 | Dec(PDWORD(P2)); |
|
| - | 3112 | end; |
|
| - | 3113 | end; |
|
| - | 3114 | end; |
|
| - | 3115 | ||
| - | 3116 | UpdateProgress(y * 2); |
|
| - | 3117 | end; |
|
| - | 3118 | finally |
|
| - | 3119 | EndProgress; |
|
| - | 3120 | end; |
|
| - | 3121 | end; |
|
| - | 3122 | end; |
|
| - | 3123 | ||
| 2254 | procedure TDIB.Blur(ABitCount: Integer; Radius: Integer); |
3124 | procedure TDIB.Blur(ABitCount: Integer; Radius: Integer); |
| 2255 | type |
3125 | type |
| 2256 | TAve = record |
3126 | TAve = record |
| 2257 | cR, cG, cB: DWORD; |
3127 | cR, cG, cB: DWORD; |
| 2258 | c: DWORD; |
3128 | c: DWORD; |
| Line 2268... | Line 3138... | ||
| 2268 | SrcP: Pointer; |
3138 | SrcP: Pointer; |
| 2269 | AveP: ^TAve; |
3139 | AveP: ^TAve; |
| 2270 | R, G, B: Byte; |
3140 | R, G, B: Byte; |
| 2271 | begin |
3141 | begin |
| 2272 | case Temp.BitCount of |
3142 | case Temp.BitCount of |
| - | 3143 | 1: |
|
| 2273 | 1 : begin |
3144 | begin |
| 2274 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3145 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2275 | AveP := @Ave; |
3146 | AveP := @Ave; |
| 2276 | for x:=0 to XCount-1 do |
3147 | for x := 0 to XCount - 1 do |
| - | 3148 | begin |
|
| - | 3149 | with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
|
| 2277 | begin |
3150 | begin |
| 2278 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
- | |
| 2279 | begin |
- | |
| 2280 | Inc(cR, rgbRed); |
3151 | Inc(cR, rgbRed); |
| 2281 | Inc(cG, rgbGreen); |
3152 | Inc(cG, rgbGreen); |
| 2282 | Inc(cB, rgbBlue); |
3153 | Inc(cB, rgbBlue); |
| 2283 | Inc(c); |
3154 | Inc(c); |
| 2284 | end; |
- | |
| 2285 | Inc(AveP); |
- | |
| 2286 | end; |
3155 | end; |
| - | 3156 | Inc(AveP); |
|
| 2287 | end; |
3157 | end; |
| - | 3158 | end; |
|
| - | 3159 | 4: |
|
| 2288 | 4 : begin |
3160 | begin |
| 2289 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3161 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2290 | AveP := @Ave; |
3162 | AveP := @Ave; |
| 2291 | for x:=0 to XCount-1 do |
3163 | for x := 0 to XCount - 1 do |
| - | 3164 | begin |
|
| - | 3165 | with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
|
| 2292 | begin |
3166 | begin |
| 2293 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
- | |
| 2294 | begin |
- | |
| 2295 | Inc(cR, rgbRed); |
3167 | Inc(cR, rgbRed); |
| 2296 | Inc(cG, rgbGreen); |
3168 | Inc(cG, rgbGreen); |
| 2297 | Inc(cB, rgbBlue); |
3169 | Inc(cB, rgbBlue); |
| 2298 | Inc(c); |
3170 | Inc(c); |
| 2299 | end; |
- | |
| 2300 | Inc(AveP); |
- | |
| 2301 | end; |
3171 | end; |
| - | 3172 | Inc(AveP); |
|
| 2302 | end; |
3173 | end; |
| - | 3174 | end; |
|
| - | 3175 | 8: |
|
| 2303 | 8 : begin |
3176 | begin |
| 2304 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3177 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2305 | AveP := @Ave; |
3178 | AveP := @Ave; |
| 2306 | for x:=0 to XCount-1 do |
3179 | for x := 0 to XCount - 1 do |
| - | 3180 | begin |
|
| - | 3181 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
|
| 2307 | begin |
3182 | begin |
| 2308 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
- | |
| 2309 | begin |
- | |
| 2310 | Inc(cR, rgbRed); |
3183 | Inc(cR, rgbRed); |
| 2311 | Inc(cG, rgbGreen); |
3184 | Inc(cG, rgbGreen); |
| 2312 | Inc(cB, rgbBlue); |
3185 | Inc(cB, rgbBlue); |
| 2313 | Inc(c); |
3186 | Inc(c); |
| 2314 | end; |
- | |
| 2315 | Inc(PByte(SrcP)); |
- | |
| 2316 | Inc(AveP); |
- | |
| 2317 | end; |
3187 | end; |
| - | 3188 | Inc(PByte(SrcP)); |
|
| - | 3189 | Inc(AveP); |
|
| 2318 | end; |
3190 | end; |
| - | 3191 | end; |
|
| - | 3192 | 16: |
|
| 2319 | 16: begin |
3193 | begin |
| 2320 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3194 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2321 | AveP := @Ave; |
3195 | AveP := @Ave; |
| 2322 | for x:=0 to XCount-1 do |
3196 | for x := 0 to XCount - 1 do |
| - | 3197 | begin |
|
| - | 3198 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
|
| - | 3199 | with AveP^ do |
|
| 2323 | begin |
3200 | begin |
| 2324 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
- | |
| 2325 | with AveP^ do |
- | |
| 2326 | begin |
- | |
| 2327 | Inc(cR, R); |
3201 | Inc(cR, R); |
| 2328 | Inc(cG, G); |
3202 | Inc(cG, G); |
| 2329 | Inc(cB, B); |
3203 | Inc(cB, B); |
| 2330 | Inc(c); |
3204 | Inc(c); |
| 2331 | end; |
- | |
| 2332 | Inc(PWord(SrcP)); |
- | |
| 2333 | Inc(AveP); |
- | |
| 2334 | end; |
3205 | end; |
| - | 3206 | Inc(PWord(SrcP)); |
|
| - | 3207 | Inc(AveP); |
|
| 2335 | end; |
3208 | end; |
| - | 3209 | end; |
|
| - | 3210 | 24: |
|
| 2336 | 24: begin |
3211 | begin |
| 2337 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3212 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2338 | AveP := @Ave; |
3213 | AveP := @Ave; |
| 2339 | for x:=0 to XCount-1 do |
3214 | for x := 0 to XCount - 1 do |
| - | 3215 | begin |
|
| - | 3216 | with PBGR(SrcP)^, AveP^ do |
|
| 2340 | begin |
3217 | begin |
| 2341 | with PBGR(SrcP)^, AveP^ do |
- | |
| 2342 | begin |
- | |
| 2343 | Inc(cR, R); |
3218 | Inc(cR, R); |
| 2344 | Inc(cG, G); |
3219 | Inc(cG, G); |
| 2345 | Inc(cB, B); |
3220 | Inc(cB, B); |
| 2346 | Inc(c); |
3221 | Inc(c); |
| 2347 | end; |
- | |
| 2348 | Inc(PBGR(SrcP)); |
- | |
| 2349 | Inc(AveP); |
- | |
| 2350 | end; |
3222 | end; |
| - | 3223 | Inc(PBGR(SrcP)); |
|
| - | 3224 | Inc(AveP); |
|
| 2351 | end; |
3225 | end; |
| - | 3226 | end; |
|
| - | 3227 | 32: |
|
| 2352 | 32: begin |
3228 | begin |
| 2353 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3229 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2354 | AveP := @Ave; |
3230 | AveP := @Ave; |
| 2355 | for x:=0 to XCount-1 do |
3231 | for x := 0 to XCount - 1 do |
| - | 3232 | begin |
|
| - | 3233 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
|
| - | 3234 | with AveP^ do |
|
| 2356 | begin |
3235 | begin |
| 2357 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
- | |
| 2358 | with AveP^ do |
- | |
| 2359 | begin |
- | |
| 2360 | Inc(cR, R); |
3236 | Inc(cR, R); |
| 2361 | Inc(cG, G); |
3237 | Inc(cG, G); |
| 2362 | Inc(cB, B); |
3238 | Inc(cB, B); |
| 2363 | Inc(c); |
3239 | Inc(c); |
| 2364 | end; |
- | |
| 2365 | Inc(PDWORD(SrcP)); |
- | |
| 2366 | Inc(AveP); |
- | |
| 2367 | end; |
3240 | end; |
| - | 3241 | Inc(PDWORD(SrcP)); |
|
| - | 3242 | Inc(AveP); |
|
| 2368 | end; |
3243 | end; |
| - | 3244 | end; |
|
| 2369 | end; |
3245 | end; |
| 2370 | end; |
3246 | end; |
| 2371 | 3247 | ||
| 2372 | procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve); |
3248 | procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve); |
| 2373 | var |
3249 | var |
| Line 2375... | Line 3251... | ||
| 2375 | SrcP: Pointer; |
3251 | SrcP: Pointer; |
| 2376 | AveP: ^TAve; |
3252 | AveP: ^TAve; |
| 2377 | R, G, B: Byte; |
3253 | R, G, B: Byte; |
| 2378 | begin |
3254 | begin |
| 2379 | case Temp.BitCount of |
3255 | case Temp.BitCount of |
| - | 3256 | 1: |
|
| 2380 | 1 : begin |
3257 | begin |
| 2381 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3258 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2382 | AveP := @Ave; |
3259 | AveP := @Ave; |
| 2383 | for x:=0 to XCount-1 do |
3260 | for x := 0 to XCount - 1 do |
| - | 3261 | begin |
|
| - | 3262 | with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
|
| 2384 | begin |
3263 | begin |
| 2385 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do |
- | |
| 2386 | begin |
- | |
| 2387 | Dec(cR, rgbRed); |
3264 | Dec(cR, rgbRed); |
| 2388 | Dec(cG, rgbGreen); |
3265 | Dec(cG, rgbGreen); |
| 2389 | Dec(cB, rgbBlue); |
3266 | Dec(cB, rgbBlue); |
| 2390 | Dec(c); |
3267 | Dec(c); |
| 2391 | end; |
- | |
| 2392 | Inc(AveP); |
- | |
| 2393 | end; |
3268 | end; |
| - | 3269 | Inc(AveP); |
|
| 2394 | end; |
3270 | end; |
| - | 3271 | end; |
|
| - | 3272 | 4: |
|
| 2395 | 4 : begin |
3273 | begin |
| 2396 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3274 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2397 | AveP := @Ave; |
3275 | AveP := @Ave; |
| 2398 | for x:=0 to XCount-1 do |
3276 | for x := 0 to XCount - 1 do |
| - | 3277 | begin |
|
| - | 3278 | with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
|
| 2399 | begin |
3279 | begin |
| 2400 | with Temp.ColorTable[(PByte(Integer(SrcP)+X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do |
- | |
| 2401 | begin |
- | |
| 2402 | Dec(cR, rgbRed); |
3280 | Dec(cR, rgbRed); |
| 2403 | Dec(cG, rgbGreen); |
3281 | Dec(cG, rgbGreen); |
| 2404 | Dec(cB, rgbBlue); |
3282 | Dec(cB, rgbBlue); |
| 2405 | Dec(c); |
3283 | Dec(c); |
| 2406 | end; |
- | |
| 2407 | Inc(AveP); |
- | |
| 2408 | end; |
3284 | end; |
| - | 3285 | Inc(AveP); |
|
| 2409 | end; |
3286 | end; |
| - | 3287 | end; |
|
| - | 3288 | 8: |
|
| 2410 | 8 : begin |
3289 | begin |
| 2411 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3290 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2412 | AveP := @Ave; |
3291 | AveP := @Ave; |
| 2413 | for x:=0 to XCount-1 do |
3292 | for x := 0 to XCount - 1 do |
| - | 3293 | begin |
|
| - | 3294 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
|
| 2414 | begin |
3295 | begin |
| 2415 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
- | |
| 2416 | begin |
- | |
| 2417 | Dec(cR, rgbRed); |
3296 | Dec(cR, rgbRed); |
| 2418 | Dec(cG, rgbGreen); |
3297 | Dec(cG, rgbGreen); |
| 2419 | Dec(cB, rgbBlue); |
3298 | Dec(cB, rgbBlue); |
| 2420 | Dec(c); |
3299 | Dec(c); |
| 2421 | end; |
- | |
| 2422 | Inc(PByte(SrcP)); |
- | |
| 2423 | Inc(AveP); |
- | |
| 2424 | end; |
3300 | end; |
| - | 3301 | Inc(PByte(SrcP)); |
|
| - | 3302 | Inc(AveP); |
|
| 2425 | end; |
3303 | end; |
| - | 3304 | end; |
|
| - | 3305 | 16: |
|
| 2426 | 16: begin |
3306 | begin |
| 2427 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3307 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2428 | AveP := @Ave; |
3308 | AveP := @Ave; |
| 2429 | for x:=0 to XCount-1 do |
3309 | for x := 0 to XCount - 1 do |
| - | 3310 | begin |
|
| - | 3311 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
|
| - | 3312 | with AveP^ do |
|
| 2430 | begin |
3313 | begin |
| 2431 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
- | |
| 2432 | with AveP^ do |
- | |
| 2433 | begin |
- | |
| 2434 | Dec(cR, R); |
3314 | Dec(cR, R); |
| 2435 | Dec(cG, G); |
3315 | Dec(cG, G); |
| 2436 | Dec(cB, B); |
3316 | Dec(cB, B); |
| 2437 | Dec(c); |
3317 | Dec(c); |
| 2438 | end; |
- | |
| 2439 | Inc(PWord(SrcP)); |
- | |
| 2440 | Inc(AveP); |
- | |
| 2441 | end; |
3318 | end; |
| - | 3319 | Inc(PWord(SrcP)); |
|
| - | 3320 | Inc(AveP); |
|
| 2442 | end; |
3321 | end; |
| - | 3322 | end; |
|
| - | 3323 | 24: |
|
| 2443 | 24: begin |
3324 | begin |
| 2444 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3325 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2445 | AveP := @Ave; |
3326 | AveP := @Ave; |
| 2446 | for x:=0 to XCount-1 do |
3327 | for x := 0 to XCount - 1 do |
| - | 3328 | begin |
|
| - | 3329 | with PBGR(SrcP)^, AveP^ do |
|
| 2447 | begin |
3330 | begin |
| 2448 | with PBGR(SrcP)^, AveP^ do |
- | |
| 2449 | begin |
- | |
| 2450 | Dec(cR, R); |
3331 | Dec(cR, R); |
| 2451 | Dec(cG, G); |
3332 | Dec(cG, G); |
| 2452 | Dec(cB, B); |
3333 | Dec(cB, B); |
| 2453 | Dec(c); |
3334 | Dec(c); |
| 2454 | end; |
- | |
| 2455 | Inc(PBGR(SrcP)); |
- | |
| 2456 | Inc(AveP); |
- | |
| 2457 | end; |
3335 | end; |
| - | 3336 | Inc(PBGR(SrcP)); |
|
| - | 3337 | Inc(AveP); |
|
| 2458 | end; |
3338 | end; |
| - | 3339 | end; |
|
| - | 3340 | 32: |
|
| 2459 | 32: begin |
3341 | begin |
| 2460 | SrcP := Pointer(Integer(Temp.TopPBits)+Y*Temp.NextLine); |
3342 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
| 2461 | AveP := @Ave; |
3343 | AveP := @Ave; |
| 2462 | for x:=0 to XCount-1 do |
3344 | for x := 0 to XCount - 1 do |
| - | 3345 | begin |
|
| - | 3346 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
|
| - | 3347 | with AveP^ do |
|
| 2463 | begin |
3348 | begin |
| 2464 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
- | |
| 2465 | with AveP^ do |
- | |
| 2466 | begin |
- | |
| 2467 | Dec(cR, R); |
3349 | Dec(cR, R); |
| 2468 | Dec(cG, G); |
3350 | Dec(cG, G); |
| 2469 | Dec(cB, B); |
3351 | Dec(cB, B); |
| 2470 | Dec(c); |
3352 | Dec(c); |
| 2471 | end; |
- | |
| 2472 | Inc(PDWORD(SrcP)); |
- | |
| 2473 | Inc(AveP); |
- | |
| 2474 | end; |
3353 | end; |
| - | 3354 | Inc(PDWORD(SrcP)); |
|
| - | 3355 | Inc(AveP); |
|
| 2475 | end; |
3356 | end; |
| - | 3357 | end; |
|
| 2476 | end; |
3358 | end; |
| 2477 | end; |
3359 | end; |
| 2478 | 3360 | ||
| 2479 | procedure Blur_Radius_Other; |
3361 | procedure Blur_Radius_Other; |
| 2480 | var |
3362 | var |
| Line 2483... | Line 3365... | ||
| 2483 | Ave: TAve; |
3365 | Ave: TAve; |
| 2484 | AveX: ^TArrayAve; |
3366 | AveX: ^TArrayAve; |
| 2485 | DestP: Pointer; |
3367 | DestP: Pointer; |
| 2486 | P: PByte; |
3368 | P: PByte; |
| 2487 | begin |
3369 | begin |
| 2488 | GetMem(AveX, Width*SizeOf(TAve)); |
3370 | GetMem(AveX, Width * SizeOf(TAve)); |
| 2489 | try |
3371 | try |
| 2490 | FillChar(AveX^, Width*SizeOf(TAve), 0); |
3372 | FillChar(AveX^, Width * SizeOf(TAve), 0); |
| 2491 | 3373 | ||
| 2492 | FirstX2 := -1; |
3374 | FirstX2 := -1; |
| 2493 | LastX2 := -1; |
3375 | LastX2 := -1; |
| 2494 | FirstY := -1; |
3376 | FirstY := -1; |
| 2495 | LastY := -1; |
3377 | LastY := -1; |
| 2496 | 3378 | ||
| 2497 | x := 0; |
3379 | x := 0; |
| 2498 | for x2:=-Radius to Radius do |
3380 | for x2 := -Radius to Radius do |
| 2499 | begin |
3381 | begin |
| 2500 | jx := x+x2; |
3382 | jx := x + x2; |
| 2501 | if (jx>=0) and (jx<Width) then |
3383 | if (jx >= 0) and (jx < Width) then |
| 2502 | begin |
3384 | begin |
| 2503 | if FirstX2=-1 then FirstX2 := jx; |
3385 | if FirstX2 = -1 then FirstX2 := jx; |
| 2504 | if LastX2<jx then LastX2 := jx; |
3386 | if LastX2 < jx then LastX2 := jx; |
| 2505 | end; |
3387 | end; |
| 2506 | end; |
3388 | end; |
| 2507 | 3389 | ||
| 2508 | y := 0; |
3390 | y := 0; |
| 2509 | for y2:=-Radius to Radius do |
3391 | for y2 := -Radius to Radius do |
| 2510 | begin |
3392 | begin |
| 2511 | jy := y+y2; |
3393 | jy := y + y2; |
| 2512 | if (jy>=0) and (jy<Height) then |
3394 | if (jy >= 0) and (jy < Height) then |
| 2513 | begin |
3395 | begin |
| 2514 | if FirstY=-1 then FirstY := jy; |
3396 | if FirstY = -1 then FirstY := jy; |
| 2515 | if LastY<jy then LastY := jy; |
3397 | if LastY < jy then LastY := jy; |
| 2516 | end; |
3398 | end; |
| 2517 | end; |
3399 | end; |
| 2518 | 3400 | ||
| 2519 | for y:=FirstY to LastY do |
3401 | for y := FirstY to LastY do |
| 2520 | AddAverage(y, Temp.Width, AveX^); |
3402 | AddAverage(y, Temp.Width, AveX^); |
| 2521 | 3403 | ||
| 2522 | for y:=0 to Height-1 do |
3404 | for y := 0 to Height - 1 do |
| 2523 | begin |
3405 | begin |
| 2524 | DestP := ScanLine[y]; |
3406 | DestP := ScanLine[y]; |
| 2525 | 3407 | ||
| 2526 | { The average is updated. } |
3408 | { The average is updated. } |
| 2527 | if y-FirstY=Radius+1 then |
3409 | if y - FirstY = Radius + 1 then |
| 2528 | begin |
3410 | begin |
| 2529 | DeleteAverage(FirstY, Temp.Width, AveX^); |
3411 | DeleteAverage(FirstY, Temp.Width, AveX^); |
| 2530 | Inc(FirstY); |
3412 | Inc(FirstY); |
| 2531 | end; |
3413 | end; |
| 2532 | 3414 | ||
| 2533 | if LastY-y=Radius-1 then |
3415 | if LastY - y = Radius - 1 then |
| 2534 | begin |
3416 | begin |
| 2535 | Inc(LastY); if LastY>=Height then LastY := Height-1; |
3417 | Inc(LastY); if LastY >= Height then LastY := Height - 1; |
| 2536 | AddAverage(LastY, Temp.Width, AveX^); |
3418 | AddAverage(LastY, Temp.Width, AveX^); |
| 2537 | end; |
3419 | end; |
| 2538 | 3420 | ||
| 2539 | { The average is calculated again. } |
3421 | { The average is calculated again. } |
| 2540 | FirstX := FirstX2; |
3422 | FirstX := FirstX2; |
| 2541 | LastX := LastX2; |
3423 | LastX := LastX2; |
| 2542 | 3424 | ||
| 2543 | FillChar(Ave, SizeOf(Ave), 0); |
3425 | FillChar(Ave, SizeOf(Ave), 0); |
| 2544 | for x:=FirstX to LastX do |
3426 | for x := FirstX to LastX do |
| 2545 | with AveX[x] do |
3427 | with AveX[x] do |
| 2546 | begin |
3428 | begin |
| 2547 | Inc(Ave.cR, cR); |
3429 | Inc(Ave.cR, cR); |
| 2548 | Inc(Ave.cG, cG); |
3430 | Inc(Ave.cG, cG); |
| 2549 | Inc(Ave.cB, cB); |
3431 | Inc(Ave.cB, cB); |
| 2550 | Inc(Ave.c, c); |
3432 | Inc(Ave.c, c); |
| 2551 | end; |
3433 | end; |
| 2552 | 3434 | ||
| 2553 | for x:=0 to Width-1 do |
3435 | for x := 0 to Width - 1 do |
| 2554 | begin |
3436 | begin |
| 2555 | { The average is updated. } |
3437 | { The average is updated. } |
| 2556 | if x-FirstX=Radius+1 then |
3438 | if x - FirstX = Radius + 1 then |
| 2557 | begin |
3439 | begin |
| 2558 | with AveX[FirstX] do |
3440 | with AveX[FirstX] do |
| 2559 | begin |
3441 | begin |
| 2560 | Dec(Ave.cR, cR); |
3442 | Dec(Ave.cR, cR); |
| 2561 | Dec(Ave.cG, cG); |
3443 | Dec(Ave.cG, cG); |
| Line 2563... | Line 3445... | ||
| 2563 | Dec(Ave.c, c); |
3445 | Dec(Ave.c, c); |
| 2564 | end; |
3446 | end; |
| 2565 | Inc(FirstX); |
3447 | Inc(FirstX); |
| 2566 | end; |
3448 | end; |
| 2567 | 3449 | ||
| 2568 | if LastX-x=Radius-1 then |
3450 | if LastX - x = Radius - 1 then |
| 2569 | begin |
3451 | begin |
| 2570 | Inc(LastX); if LastX>=Width then LastX := Width-1; |
3452 | Inc(LastX); if LastX >= Width then LastX := Width - 1; |
| 2571 | with AveX[LastX] do |
3453 | with AveX[LastX] do |
| 2572 | begin |
3454 | begin |
| 2573 | Inc(Ave.cR, cR); |
3455 | Inc(Ave.cR, cR); |
| 2574 | Inc(Ave.cG, cG); |
3456 | Inc(Ave.cG, cG); |
| 2575 | Inc(Ave.cB, cB); |
3457 | Inc(Ave.cB, cB); |
| Line 2577... | Line 3459... | ||
| 2577 | end; |
3459 | end; |
| 2578 | end; |
3460 | end; |
| 2579 | 3461 | ||
| 2580 | { The average is written. } |
3462 | { The average is written. } |
| 2581 | case BitCount of |
3463 | case BitCount of |
| - | 3464 | 1: |
|
| 2582 | 1 : begin |
3465 | begin |
| 2583 | P := @PArrayByte(DestP)[X shr 3]; |
3466 | P := @PArrayByte(DestP)[X shr 3]; |
| 2584 | with Ave do |
3467 | with Ave do |
| 2585 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR+cG+cB) div c) div 3>127)) shl Shift1[X and 7]); |
3468 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR + cG + cB) div c) div 3 > 127)) shl Shift1[X and 7]); |
| 2586 | end; |
3469 | end; |
| - | 3470 | 4: |
|
| 2587 | 4 : begin |
3471 | begin |
| 2588 | P := @PArrayByte(DestP)[X shr 1]; |
3472 | P := @PArrayByte(DestP)[X shr 1]; |
| 2589 | with Ave do |
3473 | with Ave do |
| 2590 | P^ := (P^ and Mask4n[X and 1]) or (((((cR+cG+cB) div c) div 3) shr 4) shl Shift4[X and 1]); |
3474 | P^ := (P^ and Mask4n[X and 1]) or (((((cR + cG + cB) div c) div 3) shr 4) shl Shift4[X and 1]); |
| 2591 | end; |
3475 | end; |
| - | 3476 | 8: |
|
| 2592 | 8 : begin |
3477 | begin |
| 2593 | with Ave do |
3478 | with Ave do |
| 2594 | PByte(DestP)^ := ((cR+cG+cB) div c) div 3; |
3479 | PByte(DestP)^ := ((cR + cG + cB) div c) div 3; |
| 2595 | Inc(PByte(DestP)); |
3480 | Inc(PByte(DestP)); |
| 2596 | end; |
3481 | end; |
| - | 3482 | 16: |
|
| 2597 | 16: begin |
3483 | begin |
| 2598 | with Ave do |
3484 | with Ave do |
| 2599 | PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
3485 | PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
| 2600 | Inc(PWORD(DestP)); |
3486 | Inc(PWORD(DestP)); |
| 2601 | end; |
3487 | end; |
| - | 3488 | 24: |
|
| 2602 | 24: begin |
3489 | begin |
| 2603 | with PBGR(DestP)^, Ave do |
3490 | with PBGR(DestP)^, Ave do |
| 2604 | begin |
3491 | begin |
| 2605 | R := cR div c; |
3492 | R := cR div c; |
| 2606 | G := cG div c; |
3493 | G := cG div c; |
| 2607 | B := cB div c; |
3494 | B := cB div c; |
| 2608 | end; |
- | |
| 2609 | Inc(PBGR(DestP)); |
- | |
| 2610 | end; |
- | |
| 2611 | 32: begin |
- | |
| 2612 | with Ave do |
- | |
| 2613 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
- | |
| 2614 | Inc(PDWORD(DestP)); |
- | |
| 2615 | end; |
3495 | end; |
| - | 3496 | Inc(PBGR(DestP)); |
|
| - | 3497 | end; |
|
| - | 3498 | 32: |
|
| - | 3499 | begin |
|
| - | 3500 | with Ave do |
|
| - | 3501 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
|
| - | 3502 | Inc(PDWORD(DestP)); |
|
| - | 3503 | end; |
|
| 2616 | end; |
3504 | end; |
| 2617 | end; |
3505 | end; |
| 2618 | 3506 | ||
| 2619 | UpdateProgress(y); |
3507 | UpdateProgress(y); |
| 2620 | end; |
3508 | end; |
| Line 2624... | Line 3512... | ||
| 2624 | end; |
3512 | end; |
| 2625 | 3513 | ||
| 2626 | var |
3514 | var |
| 2627 | i, j: Integer; |
3515 | i, j: Integer; |
| 2628 | begin |
3516 | begin |
| 2629 | if Empty or (Radius=0) then Exit; |
3517 | if Empty or (Radius = 0) then Exit; |
| 2630 | 3518 | ||
| 2631 | Radius := Abs(Radius); |
3519 | Radius := Abs(Radius); |
| 2632 | 3520 | ||
| 2633 | StartProgress('Blur'); |
3521 | StartProgress('Blur'); |
| 2634 | try |
3522 | try |
| 2635 | Temp := TDIB.Create; |
3523 | Temp := TDIB.Create; |
| 2636 | try |
3524 | try |
| 2637 | Temp.Assign(Self); |
3525 | Temp.Assign(Self); |
| 2638 | SetSize(Width, Height, ABitCount); |
3526 | SetSize(Width, Height, ABitCount); |
| 2639 | 3527 | ||
| 2640 | if ABitCount<=8 then |
3528 | if ABitCount <= 8 then |
| 2641 | begin |
3529 | begin |
| 2642 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
3530 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
| 2643 | for i:=0 to (1 shl ABitCount)-1 do |
3531 | for i := 0 to (1 shl ABitCount) - 1 do |
| 2644 | begin |
3532 | begin |
| 2645 | j := i * (1 shl (8-ABitCount)); |
3533 | j := i * (1 shl (8 - ABitCount)); |
| 2646 | j := j or (j shr ABitCount); |
3534 | j := j or (j shr ABitCount); |
| 2647 | ColorTable[i] := RGBQuad(j, j, j); |
3535 | ColorTable[i] := RGBQuad(j, j, j); |
| 2648 | end; |
3536 | end; |
| 2649 | UpdatePalette; |
3537 | UpdatePalette; |
| 2650 | end; |
3538 | end; |
| Line 2656... | Line 3544... | ||
| 2656 | finally |
3544 | finally |
| 2657 | EndProgress; |
3545 | EndProgress; |
| 2658 | end; |
3546 | end; |
| 2659 | end; |
3547 | end; |
| 2660 | 3548 | ||
| - | 3549 | procedure TDIB.Negative; |
|
| - | 3550 | var |
|
| - | 3551 | i, i2: Integer; |
|
| - | 3552 | P: Pointer; |
|
| - | 3553 | begin |
|
| - | 3554 | if Empty then exit; |
|
| - | 3555 | ||
| - | 3556 | if BitCount <= 8 then |
|
| - | 3557 | begin |
|
| - | 3558 | for i := 0 to 255 do |
|
| - | 3559 | with ColorTable[i] do |
|
| - | 3560 | begin |
|
| - | 3561 | rgbRed := 255 - rgbRed; |
|
| - | 3562 | rgbGreen := 255 - rgbGreen; |
|
| - | 3563 | rgbBlue := 255 - rgbBlue; |
|
| - | 3564 | end; |
|
| - | 3565 | UpdatePalette; |
|
| - | 3566 | end else |
|
| - | 3567 | begin |
|
| - | 3568 | P := PBits; |
|
| - | 3569 | i2 := Size; |
|
| - | 3570 | asm |
|
| - | 3571 | mov ecx,i2 |
|
| - | 3572 | mov eax,P |
|
| - | 3573 | mov edx,ecx |
|
| - | 3574 | ||
| - | 3575 | { Unit of DWORD. } |
|
| - | 3576 | @@qword_skip: |
|
| - | 3577 | shr ecx,2 |
|
| - | 3578 | jz @@dword_skip |
|
| - | 3579 | ||
| - | 3580 | dec ecx |
|
| - | 3581 | @@dword_loop: |
|
| - | 3582 | not dword ptr [eax+ecx*4] |
|
| - | 3583 | dec ecx |
|
| - | 3584 | jnl @@dword_loop |
|
| - | 3585 | ||
| - | 3586 | mov ecx,edx |
|
| - | 3587 | shr ecx,2 |
|
| - | 3588 | add eax,ecx*4 |
|
| - | 3589 | ||
| - | 3590 | { Unit of Byte. } |
|
| - | 3591 | @@dword_skip: |
|
| - | 3592 | mov ecx,edx |
|
| - | 3593 | and ecx,3 |
|
| - | 3594 | jz @@byte_skip |
|
| - | 3595 | ||
| - | 3596 | dec ecx |
|
| - | 3597 | @@loop_byte: |
|
| - | 3598 | not byte ptr [eax+ecx] |
|
| - | 3599 | dec ecx |
|
| - | 3600 | jnl @@loop_byte |
|
| - | 3601 | ||
| - | 3602 | @@byte_skip: |
|
| - | 3603 | end; |
|
| - | 3604 | end; |
|
| - | 3605 | end; |
|
| - | 3606 | ||
| 2661 | procedure TDIB.Greyscale(ABitCount: Integer); |
3607 | procedure TDIB.Greyscale(ABitCount: Integer); |
| 2662 | var |
3608 | var |
| 2663 | YTblR, YTblG, YTblB: array[0..255] of Byte; |
3609 | YTblR, YTblG, YTblB: array[0..255] of Byte; |
| 2664 | i, j, x, y: Integer; |
3610 | i, j, x, y: Integer; |
| 2665 | c: DWORD; |
3611 | c: DWORD; |
| 2666 | R, G, B: Byte; |
3612 | R, G, B: Byte; |
| 2667 | Temp: TDIB; |
3613 | Temp: TDIB; |
| 2668 | DestP, SrcP: Pointer; |
3614 | DestP, SrcP: Pointer; |
| 2669 | P: PByte; |
3615 | P: PByte; |
| 2670 | begin |
3616 | begin |
| 2671 | if Empty then exit; |
3617 | if Empty then Exit; |
| 2672 | 3618 | ||
| 2673 | Temp := TDIB.Create; |
3619 | Temp := TDIB.Create; |
| 2674 | try |
3620 | try |
| 2675 | Temp.Assign(Self); |
3621 | Temp.Assign(Self); |
| 2676 | SetSize(Width, Height, ABitCount); |
3622 | SetSize(Width, Height, ABitCount); |
| 2677 | 3623 | ||
| 2678 | if ABitCount<=8 then |
3624 | if ABitCount <= 8 then |
| 2679 | begin |
3625 | begin |
| 2680 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
3626 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
| 2681 | for i:=0 to (1 shl ABitCount)-1 do |
3627 | for i := 0 to (1 shl ABitCount) - 1 do |
| 2682 | begin |
3628 | begin |
| 2683 | j := i * (1 shl (8-ABitCount)); |
3629 | j := i * (1 shl (8 - ABitCount)); |
| 2684 | j := j or (j shr ABitCount); |
3630 | j := j or (j shr ABitCount); |
| 2685 | ColorTable[i] := RGBQuad(j, j, j); |
3631 | ColorTable[i] := RGBQuad(j, j, j); |
| 2686 | end; |
3632 | end; |
| 2687 | UpdatePalette; |
3633 | UpdatePalette; |
| 2688 | end; |
3634 | end; |
| 2689 | 3635 | ||
| 2690 | for i:=0 to 255 do |
3636 | for i := 0 to 255 do |
| 2691 | begin |
3637 | begin |
| 2692 | YTblR[i] := Trunc(0.3588*i); |
3638 | YTblR[i] := Trunc(0.3588 * i); |
| 2693 | YTblG[i] := Trunc(0.4020*i); |
3639 | YTblG[i] := Trunc(0.4020 * i); |
| 2694 | YTblB[i] := Trunc(0.2392*i); |
3640 | YTblB[i] := Trunc(0.2392 * i); |
| 2695 | end; |
3641 | end; |
| 2696 | 3642 | ||
| 2697 | c := 0; |
3643 | c := 0; |
| 2698 | 3644 | ||
| 2699 | StartProgress('Greyscale'); |
3645 | StartProgress('Greyscale'); |
| 2700 | try |
3646 | try |
| 2701 | for y:=0 to Height-1 do |
3647 | for y := 0 to Height - 1 do |
| 2702 | begin |
3648 | begin |
| 2703 | DestP := ScanLine[y]; |
3649 | DestP := ScanLine[y]; |
| 2704 | SrcP := Temp.ScanLine[y]; |
3650 | SrcP := Temp.ScanLine[y]; |
| 2705 | 3651 | ||
| 2706 | for x:=0 to Width-1 do |
3652 | for x := 0 to Width - 1 do |
| 2707 | begin |
3653 | begin |
| 2708 | case Temp.BitCount of |
3654 | case Temp.BitCount of |
| - | 3655 | 1: |
|
| 2709 | 1 : begin |
3656 | begin |
| 2710 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
3657 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
| 2711 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
3658 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| 2712 | end; |
3659 | end; |
| - | 3660 | 4: |
|
| 2713 | 4 : begin |
3661 | begin |
| 2714 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
3662 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
| 2715 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
3663 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| 2716 | end; |
3664 | end; |
| - | 3665 | 8: |
|
| 2717 | 8 : begin |
3666 | begin |
| 2718 | with Temp.ColorTable[PByte(SrcP)^] do |
3667 | with Temp.ColorTable[PByte(SrcP)^] do |
| 2719 | c := YTblR[rgbRed]+YTblG[rgbGreen]+YTblB[rgbBlue]; |
3668 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
| 2720 | Inc(PByte(SrcP)); |
3669 | Inc(PByte(SrcP)); |
| 2721 | end; |
3670 | end; |
| - | 3671 | 16: |
|
| 2722 | 16: begin |
3672 | begin |
| 2723 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
3673 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
| 2724 | c := YTblR[R]+YTblR[G]+YTblR[B]; |
3674 | c := YTblR[R] + YTblR[G] + YTblR[B]; |
| 2725 | Inc(PWord(SrcP)); |
3675 | Inc(PWord(SrcP)); |
| 2726 | end; |
3676 | end; |
| - | 3677 | 24: |
|
| 2727 | 24: begin |
3678 | begin |
| 2728 | with PBGR(SrcP)^ do |
3679 | with PBGR(SrcP)^ do |
| 2729 | c := YTblR[R]+YTblG[G]+YTblB[B]; |
3680 | c := YTblR[R] + YTblG[G] + YTblB[B]; |
| 2730 | Inc(PBGR(SrcP)); |
3681 | Inc(PBGR(SrcP)); |
| 2731 | end; |
3682 | end; |
| - | 3683 | 32: |
|
| 2732 | 32: begin |
3684 | begin |
| 2733 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
3685 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
| 2734 | c := YTblR[R]+YTblR[G]+YTblR[B]; |
3686 | c := YTblR[R] + YTblR[G] + YTblR[B]; |
| 2735 | Inc(PDWORD(SrcP)); |
3687 | Inc(PDWORD(SrcP)); |
| 2736 | end; |
3688 | end; |
| 2737 | end; |
3689 | end; |
| 2738 | 3690 | ||
| 2739 | case BitCount of |
3691 | case BitCount of |
| - | 3692 | 1: |
|
| 2740 | 1 : begin |
3693 | begin |
| 2741 | P := @PArrayByte(DestP)[X shr 3]; |
3694 | P := @PArrayByte(DestP)[X shr 3]; |
| 2742 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c>127)) shl Shift1[X and 7]); |
3695 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c > 127)) shl Shift1[X and 7]); |
| 2743 | end; |
3696 | end; |
| - | 3697 | 4: |
|
| 2744 | 4 : begin |
3698 | begin |
| 2745 | P := @PArrayByte(DestP)[X shr 1]; |
3699 | P := @PArrayByte(DestP)[X shr 1]; |
| 2746 | P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]); |
3700 | P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]); |
| 2747 | end; |
3701 | end; |
| - | 3702 | 8: |
|
| 2748 | 8 : begin |
3703 | begin |
| 2749 | PByte(DestP)^ := c; |
3704 | PByte(DestP)^ := c; |
| 2750 | Inc(PByte(DestP)); |
3705 | Inc(PByte(DestP)); |
| 2751 | end; |
3706 | end; |
| - | 3707 | 16: |
|
| 2752 | 16: begin |
3708 | begin |
| 2753 | PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
3709 | PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
| 2754 | Inc(PWord(DestP)); |
3710 | Inc(PWord(DestP)); |
| 2755 | end; |
3711 | end; |
| 2756 | 24: begin |
3712 | 24: |
| 2757 | with PBGR(DestP)^ do |
- | |
| 2758 | begin |
3713 | begin |
| 2759 | R := c; |
3714 | with PBGR(DestP)^ do |
| 2760 | G := c; |
3715 | begin |
| 2761 | B := c; |
3716 | R := c; |
| 2762 | end; |
3717 | G := c; |
| 2763 | Inc(PBGR(DestP)); |
- | |
| 2764 | end; |
3718 | B := c; |
| 2765 | 32: begin |
- | |
| 2766 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
- | |
| 2767 | Inc(PDWORD(DestP)); |
- | |
| 2768 | end; |
3719 | end; |
| - | 3720 | Inc(PBGR(DestP)); |
|
| - | 3721 | end; |
|
| - | 3722 | 32: |
|
| - | 3723 | begin |
|
| - | 3724 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
|
| - | 3725 | Inc(PDWORD(DestP)); |
|
| - | 3726 | end; |
|
| 2769 | end; |
3727 | end; |
| 2770 | end; |
3728 | end; |
| 2771 | 3729 | ||
| 2772 | UpdateProgress(y); |
3730 | UpdateProgress(y); |
| 2773 | end; |
3731 | end; |
| Line 2777... | Line 3735... | ||
| 2777 | finally |
3735 | finally |
| 2778 | Temp.Free; |
3736 | Temp.Free; |
| 2779 | end; |
3737 | end; |
| 2780 | end; |
3738 | end; |
| 2781 | 3739 | ||
| - | 3740 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3741 | // Version : 0.1 - 26/06/2000 // |
|
| - | 3742 | // Version : 0.2 - 04/07/2000 // |
|
| - | 3743 | // At someone's request, i have added 3 news effects : // |
|
| - | 3744 | // 1 - Rotate // |
|
| - | 3745 | // 2 - SplitBlur // |
|
| - | 3746 | // 3 - GaussianBlur // |
|
| - | 3747 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3748 | // - NEW SPECIAL EFFECT - (English) // |
|
| - | 3749 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3750 | // At the start, my idea was to create a component derived from TCustomDXDraw. Unfortunately, // |
|
| - | 3751 | // it's impossible to run a graphic component (derived from TCustomDXDraw) in a conception's // |
|
| - | 3752 | // mode (i don't success, but perhaps, somebody know how doing ! In that case, please help me !!!)// |
|
| - | 3753 | // Then, i'm used the DIB's unit for my work, but this unit is poor in special effect. Knowing a // |
|
| - | 3754 | // library with more effect, i'm undertaked to import this library in DIB's unit. You can see the // |
|
| - | 3755 | // FastLib library at : // |
|
| - | 3756 | // // |
|
| - | 3757 | // -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody // |
|
| - | 3758 | // // |
|
| - | 3759 | // It was very difficult, because implementation's graphic was very different that DIB's unit. // |
|
| - | 3760 | // Sometimes, i'm deserted the possibility of original effect, particularly in conversion of DIB // |
|
| - | 3761 | // whith 256, 16 and 2 colors. If someone can implement this fonctionnality, thanks to tell me // |
|
| - | 3762 | // how this miracle is possible !!! // |
|
| - | 3763 | // All these procedures are translated and adapted by : // |
|
| - | 3764 | // // |
|
| - | 3765 | // -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org // |
|
| - | 3766 | // // |
|
| - | 3767 | // IMPORTANT : These procedures don't modify the DIB's unit structure // |
|
| - | 3768 | // Nota Bene : I don't implement these type of graphics (32 and 16 bit per pixels), // |
|
| - | 3769 | // for one reason : I haven't bitmaps of this type !!! // |
|
| - | 3770 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3771 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3772 | // - NOUVEAUX EFFETS SPECIAUX - (Français) // |
|
| - | 3773 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3774 | // Au commencement, mon idée était de dériver un composant de TCustomDXDraw. Malheureusement, // |
|
| - | 3775 | // c'est impossible de faire fonctionner un composant graphique (derivé de TCustomDXDraw) en mode // |
|
| - | 3776 | // conception (je n'y suis pas parvenu, mais peut-être, que quelqu'un sait comment faire ! Dans // |
|
| - | 3777 | // ce cas, vous seriez aimable de m'aider !!!) // |
|
| - | 3778 | // Alors, j'ai utilisé l'unité DIB pour mon travail,mais celle-ci est pauvre en effet spéciaux. // |
|
| - | 3779 | // Connaissant une librairie avec beaucoup plus d'effets spéciaux, j'ai entrepris d'importer // |
|
| - | 3780 | // cette librairie dans l'unité DIB. Vous pouvez voir la librairie FastLib à : // |
|
| - | 3781 | // // |
|
| - | 3782 | // -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody // |
|
| - | 3783 | // // |
|
| - | 3784 | // C'était très difficile car l'implémentation graphique est très différente de l'unité DIB. // |
|
| - | 3785 | // Parfois, j'ai abandonné les possibilités de l'effet original, particulièrement dans la // |
|
| - | 3786 | // conversion des DIB avec 256, 16 et 2 couleurs. Si quelqu'un arrive à implémenter ces // |
|
| - | 3787 | // fonctionnalités, merci de me dire comment ce miracle est possible !!! // |
|
| - | 3788 | // Toutes ces procédures ont été traduites et adaptées par: // |
|
| - | 3789 | // // |
|
| - | 3790 | // -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org // |
|
| - | 3791 | // // |
|
| - | 3792 | // IMPORTANT : Ces procédures ne modifient pas la structure de l'unité DIB // |
|
| - | 3793 | // Nota Bene : Je n'ai pas implémenté ces types de graphiques (32 et 16 bit par pixels), // |
|
| - | 3794 | // pour une raison : je n'ai pas de bitmap de ce type !!! // |
|
| - | 3795 | //-------------------------------------------------------------------------------------------------- |
|
| - | 3796 | ||
| 2782 | procedure TDIB.Mirror(MirrorX, MirrorY: Boolean); |
3797 | function TDIB.IntToColor(i: Integer): TBGR; |
| 2783 | var |
3798 | begin |
| 2784 | x, y, Width2, c: Integer; |
3799 | Result.b := i shr 16; |
| 2785 | P1, P2, TempBuf: Pointer; |
3800 | Result.g := i shr 8; |
| - | 3801 | Result.r := i; |
|
| - | 3802 | end; |
|
| - | 3803 | ||
| - | 3804 | function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; |
|
| 2786 | begin |
3805 | begin |
| 2787 | if Empty then exit; |
3806 | if iMark then |
| - | 3807 | begin |
|
| - | 3808 | if iValue < iMin then |
|
| - | 3809 | Result := iMin |
|
| - | 3810 | else |
|
| - | 3811 | if iValue > iMax then |
|
| - | 3812 | Result := iMax |
|
| - | 3813 | else |
|
| - | 3814 | Result := iValue; |
|
| - | 3815 | end |
|
| - | 3816 | else |
|
| - | 3817 | begin |
|
| 2788 | if (not MirrorX) and (not MirrorY) then Exit; |
3818 | if iValue < iMin then |
| - | 3819 | Result := iMin |
|
| - | 3820 | else |
|
| - | 3821 | if iValue > iMax then |
|
| - | 3822 | Result := iMin |
|
| - | 3823 | else |
|
| - | 3824 | Result := iValue; |
|
| - | 3825 | end; |
|
| - | 3826 | end; |
|
| 2789 | 3827 | ||
| - | 3828 | procedure TDIB.Contrast(Amount: Integer); |
|
| - | 3829 | var |
|
| - | 3830 | x, y: Integer; |
|
| 2790 | if (not MirrorX) and (MirrorY) then |
3831 | Table1: array[0..255] of Byte; |
| - | 3832 | i: Byte; |
|
| - | 3833 | S, D: pointer; |
|
| - | 3834 | Temp1: TDIB; |
|
| - | 3835 | color: DWORD; |
|
| - | 3836 | P: PByte; |
|
| - | 3837 | R, G, B: Byte; |
|
| - | 3838 | begin |
|
| - | 3839 | D := nil; |
|
| - | 3840 | S := nil; |
|
| - | 3841 | Temp1 := nil; |
|
| - | 3842 | for i := 0 to 126 do |
|
| - | 3843 | begin |
|
| - | 3844 | y := (Abs(128 - i) * Amount) div 256; |
|
| - | 3845 | Table1[i] := IntToByte(i - y); |
|
| - | 3846 | end; |
|
| - | 3847 | for i := 127 to 255 do |
|
| - | 3848 | begin |
|
| - | 3849 | y := (Abs(128 - i) * Amount) div 256; |
|
| - | 3850 | Table1[i] := IntToByte(i + y); |
|
| - | 3851 | end; |
|
| - | 3852 | case BitCount of |
|
| - | 3853 | 32: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 3854 | 24: ; // nothing to do |
|
| - | 3855 | 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
|
| - | 3856 | 8, 4: |
|
| - | 3857 | begin |
|
| - | 3858 | Temp1 := TDIB.Create; |
|
| - | 3859 | Temp1.Assign(self); |
|
| - | 3860 | Temp1.SetSize(Width, Height, BitCount); |
|
| - | 3861 | for i := 0 to 255 do |
|
| - | 3862 | begin |
|
| - | 3863 | with ColorTable[i] do |
|
| - | 3864 | begin |
|
| - | 3865 | rgbRed := IntToByte(Table1[rgbRed]); |
|
| - | 3866 | rgbGreen := IntToByte(Table1[rgbGreen]); |
|
| - | 3867 | rgbBlue := IntToByte(Table1[rgbBlue]); |
|
| - | 3868 | end; |
|
| - | 3869 | end; |
|
| - | 3870 | UpdatePalette; |
|
| - | 3871 | end; |
|
| - | 3872 | else |
|
| - | 3873 | // if the number of pixel is equal to 1 then exit of procedure |
|
| - | 3874 | Exit; |
|
| - | 3875 | end; |
|
| - | 3876 | for y := 0 to Pred(Height) do |
|
| 2791 | begin |
3877 | begin |
| 2792 | GetMem(TempBuf, WidthBytes); |
3878 | case BitCount of |
| 2793 | try |
- | |
| 2794 | StartProgress('Mirror'); |
3879 | 24, 16: D := ScanLine[y]; |
| 2795 | try |
3880 | 8, 4: |
| 2796 | for y:=0 to Height shr 1-1 do |
- | |
| 2797 | begin |
3881 | begin |
| 2798 | P1 := ScanLine[y]; |
3882 | D := Temp1.ScanLine[y]; |
| 2799 | P2 := ScanLine[Height-y-1]; |
3883 | S := Temp1.ScanLine[y]; |
| - | 3884 | end; |
|
| - | 3885 | else |
|
| 2800 | 3886 | end; |
|
| - | 3887 | for x := 0 to Pred(Width) do |
|
| - | 3888 | begin |
|
| - | 3889 | case BitCount of |
|
| - | 3890 | 32: ; |
|
| - | 3891 | 24: |
|
| - | 3892 | begin |
|
| - | 3893 | PBGR(D)^.B := Table1[PBGR(D)^.B]; |
|
| - | 3894 | PBGR(D)^.G := Table1[PBGR(D)^.G]; |
|
| - | 3895 | PBGR(D)^.R := Table1[PBGR(D)^.R]; |
|
| - | 3896 | Inc(PBGR(D)); |
|
| - | 3897 | end; |
|
| - | 3898 | 16: |
|
| - | 3899 | begin |
|
| - | 3900 | pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
|
| - | 3901 | PWord(D)^ := Table1[R] + Table1[G] + Table1[B]; |
|
| - | 3902 | Inc(PWord(D)); |
|
| - | 3903 | end; |
|
| - | 3904 | 8: |
|
| - | 3905 | begin |
|
| 2801 | Move(P1^, TempBuf^, WidthBytes); |
3906 | with Temp1.ColorTable[PByte(S)^] do |
| - | 3907 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 3908 | Inc(PByte(S)); |
|
| - | 3909 | PByte(D)^ := color; |
|
| 2802 | Move(P2^, P1^, WidthBytes); |
3910 | Inc(PByte(D)); |
| - | 3911 | end; |
|
| - | 3912 | 4: |
|
| - | 3913 | begin |
|
| 2803 | Move(TempBuf^, P2^, WidthBytes); |
3914 | with Temp1.ColorTable[PByte(S)^] do |
| - | 3915 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 3916 | Inc(PByte(S)); |
|
| - | 3917 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 3918 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| - | 3919 | end; |
|
| - | 3920 | else |
|
| - | 3921 | end; |
|
| - | 3922 | end; |
|
| - | 3923 | end; |
|
| - | 3924 | case BitCount of |
|
| - | 3925 | 8, 4: Temp1.Free; |
|
| - | 3926 | else |
|
| - | 3927 | end; |
|
| - | 3928 | end; |
|
| 2804 | 3929 | ||
| - | 3930 | procedure TDIB.Saturation(Amount: Integer); |
|
| - | 3931 | var |
|
| - | 3932 | Grays: array[0..767] of Integer; |
|
| - | 3933 | Alpha: array[0..255] of Word; |
|
| - | 3934 | Gray, x, y: Integer; |
|
| - | 3935 | i: Byte; |
|
| - | 3936 | S, D: pointer; |
|
| - | 3937 | Temp1: TDIB; |
|
| - | 3938 | color: DWORD; |
|
| - | 3939 | P: PByte; |
|
| - | 3940 | R, G, B: Byte; |
|
| - | 3941 | begin |
|
| - | 3942 | D := nil; |
|
| - | 3943 | S := nil; |
|
| - | 3944 | Temp1 := nil; |
|
| - | 3945 | for i := 0 to 255 do |
|
| - | 3946 | Alpha[i] := (i * Amount) shr 8; |
|
| - | 3947 | x := 0; |
|
| - | 3948 | for i := 0 to 255 do |
|
| - | 3949 | begin |
|
| - | 3950 | Gray := i - Alpha[i]; |
|
| - | 3951 | Grays[x] := Gray; |
|
| - | 3952 | Inc(x); |
|
| - | 3953 | Grays[x] := Gray; |
|
| - | 3954 | Inc(x); |
|
| - | 3955 | Grays[x] := Gray; |
|
| - | 3956 | Inc(x); |
|
| - | 3957 | end; |
|
| - | 3958 | case BitCount of |
|
| - | 3959 | 32: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 3960 | 24: ; // nothing to do |
|
| - | 3961 | 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
|
| - | 3962 | 8, 4: |
|
| - | 3963 | begin |
|
| - | 3964 | Temp1 := TDIB.Create; |
|
| 2805 | UpdateProgress(y*2); |
3965 | Temp1.Assign(self); |
| - | 3966 | Temp1.SetSize(Width, Height, BitCount); |
|
| - | 3967 | for i := 0 to 255 do |
|
| - | 3968 | begin |
|
| - | 3969 | with ColorTable[i] do |
|
| - | 3970 | begin |
|
| - | 3971 | Gray := Grays[rgbRed + rgbGreen + rgbBlue]; |
|
| - | 3972 | rgbRed := IntToByte(Gray + Alpha[rgbRed]); |
|
| - | 3973 | rgbGreen := IntToByte(Gray + Alpha[rgbGreen]); |
|
| - | 3974 | rgbBlue := IntToByte(Gray + Alpha[rgbBlue]); |
|
| - | 3975 | end; |
|
| 2806 | end; |
3976 | end; |
| 2807 | finally |
- | |
| 2808 | EndProgress; |
3977 | UpdatePalette; |
| 2809 | end; |
3978 | end; |
| - | 3979 | else |
|
| - | 3980 | // if the number of pixel is equal to 1 then exit of procedure |
|
| - | 3981 | Exit; |
|
| - | 3982 | end; |
|
| - | 3983 | for y := 0 to Pred(Height) do |
|
| - | 3984 | begin |
|
| - | 3985 | case BitCount of |
|
| - | 3986 | 24, 16: D := ScanLine[y]; |
|
| 2810 | finally |
3987 | 8, 4: |
| - | 3988 | begin |
|
| - | 3989 | D := Temp1.ScanLine[y]; |
|
| 2811 | FreeMem(TempBuf, WidthBytes); |
3990 | S := Temp1.ScanLine[y]; |
| - | 3991 | end; |
|
| - | 3992 | else |
|
| 2812 | end; |
3993 | end; |
| - | 3994 | for x := 0 to Pred(Width) do |
|
| - | 3995 | begin |
|
| - | 3996 | case BitCount of |
|
| - | 3997 | 32: ; |
|
| - | 3998 | 24: |
|
| - | 3999 | begin |
|
| - | 4000 | Gray := Grays[PBGR(D)^.R + PBGR(D)^.G + PBGR(D)^.B]; |
|
| - | 4001 | PBGR(D)^.B := IntToByte(Gray + Alpha[PBGR(D)^.B]); |
|
| - | 4002 | PBGR(D)^.G := IntToByte(Gray + Alpha[PBGR(D)^.G]); |
|
| - | 4003 | PBGR(D)^.R := IntToByte(Gray + Alpha[PBGR(D)^.R]); |
|
| - | 4004 | Inc(PBGR(D)); |
|
| - | 4005 | end; |
|
| - | 4006 | 16: |
|
| - | 4007 | begin |
|
| - | 4008 | pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
|
| - | 4009 | PWord(D)^ := IntToByte(Gray + Alpha[B]) + IntToByte(Gray + Alpha[G]) + |
|
| - | 4010 | IntToByte(Gray + Alpha[R]); |
|
| - | 4011 | Inc(PWord(D)); |
|
| - | 4012 | end; |
|
| - | 4013 | 8: |
|
| - | 4014 | begin |
|
| - | 4015 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4016 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4017 | Inc(PByte(S)); |
|
| - | 4018 | PByte(D)^ := color; |
|
| - | 4019 | Inc(PByte(D)); |
|
| - | 4020 | end; |
|
| - | 4021 | 4: |
|
| - | 4022 | begin |
|
| - | 4023 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4024 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4025 | Inc(PByte(S)); |
|
| - | 4026 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4027 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| - | 4028 | end; |
|
| - | 4029 | else |
|
| - | 4030 | end; |
|
| - | 4031 | end; |
|
| - | 4032 | end; |
|
| - | 4033 | case BitCount of |
|
| - | 4034 | 8, 4: Temp1.Free; |
|
| - | 4035 | else |
|
| - | 4036 | end; |
|
| - | 4037 | end; |
|
| - | 4038 | ||
| - | 4039 | procedure TDIB.Lightness(Amount: Integer); |
|
| - | 4040 | var |
|
| - | 4041 | x, y: Integer; |
|
| - | 4042 | Table1: array[0..255] of Byte; |
|
| - | 4043 | i: Byte; |
|
| - | 4044 | S, D: pointer; |
|
| - | 4045 | Temp1: TDIB; |
|
| - | 4046 | color: DWORD; |
|
| - | 4047 | P: PByte; |
|
| - | 4048 | R, G, B: Byte; |
|
| - | 4049 | begin |
|
| - | 4050 | D := nil; |
|
| - | 4051 | S := nil; |
|
| - | 4052 | Temp1 := nil; |
|
| - | 4053 | if Amount < 0 then |
|
| - | 4054 | begin |
|
| - | 4055 | Amount := -Amount; |
|
| - | 4056 | for i := 0 to 255 do |
|
| 2813 | end else if (MirrorX) and (not MirrorY) then |
4057 | Table1[i] := IntToByte(i - ((Amount * i) shr 8)); |
| - | 4058 | end |
|
| - | 4059 | else |
|
| - | 4060 | for i := 0 to 255 do |
|
| - | 4061 | Table1[i] := IntToByte(i + ((Amount * (i xor 255)) shr 8)); |
|
| - | 4062 | case BitCount of |
|
| - | 4063 | 32: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 4064 | 24: ; // nothing to do |
|
| - | 4065 | 16: ; // I have an artificial bitmap for this type ! i don't sure that it works |
|
| - | 4066 | 8, 4: |
|
| - | 4067 | begin |
|
| - | 4068 | Temp1 := TDIB.Create; |
|
| - | 4069 | Temp1.Assign(self); |
|
| - | 4070 | Temp1.SetSize(Width, Height, BitCount); |
|
| - | 4071 | for i := 0 to 255 do |
|
| - | 4072 | begin |
|
| - | 4073 | with ColorTable[i] do |
|
| - | 4074 | begin |
|
| - | 4075 | rgbRed := IntToByte(Table1[rgbRed]); |
|
| - | 4076 | rgbGreen := IntToByte(Table1[rgbGreen]); |
|
| - | 4077 | rgbBlue := IntToByte(Table1[rgbBlue]); |
|
| - | 4078 | end; |
|
| - | 4079 | end; |
|
| - | 4080 | UpdatePalette; |
|
| - | 4081 | end; |
|
| - | 4082 | else |
|
| - | 4083 | // if the number of pixel is equal to 1 then exit of procedure |
|
| - | 4084 | Exit; |
|
| - | 4085 | end; |
|
| - | 4086 | for y := 0 to Pred(Height) do |
|
| 2814 | begin |
4087 | begin |
| - | 4088 | case BitCount of |
|
| - | 4089 | 24, 16: D := ScanLine[y]; |
|
| - | 4090 | 8, 4: |
|
| - | 4091 | begin |
|
| - | 4092 | D := Temp1.ScanLine[y]; |
|
| - | 4093 | S := Temp1.ScanLine[y]; |
|
| - | 4094 | end; |
|
| - | 4095 | else |
|
| - | 4096 | end; |
|
| - | 4097 | for x := 0 to Pred(Width) do |
|
| - | 4098 | begin |
|
| 2815 | Width2 := Width shr 1; |
4099 | case BitCount of |
| - | 4100 | 32: ; |
|
| - | 4101 | 24: |
|
| - | 4102 | begin |
|
| - | 4103 | PBGR(D)^.B := Table1[PBGR(D)^.B]; |
|
| - | 4104 | PBGR(D)^.G := Table1[PBGR(D)^.G]; |
|
| - | 4105 | PBGR(D)^.R := Table1[PBGR(D)^.R]; |
|
| - | 4106 | Inc(PBGR(D)); |
|
| - | 4107 | end; |
|
| - | 4108 | 16: |
|
| - | 4109 | begin |
|
| - | 4110 | pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
|
| - | 4111 | PWord(D)^ := Table1[R] + Table1[G] + Table1[B]; |
|
| - | 4112 | Inc(PWord(D)); |
|
| - | 4113 | end; |
|
| - | 4114 | 8: |
|
| - | 4115 | begin |
|
| - | 4116 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4117 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4118 | Inc(PByte(S)); |
|
| - | 4119 | PByte(D)^ := color; |
|
| - | 4120 | Inc(PByte(D)); |
|
| - | 4121 | end; |
|
| - | 4122 | 4: |
|
| - | 4123 | begin |
|
| - | 4124 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4125 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4126 | Inc(PByte(S)); |
|
| - | 4127 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4128 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| - | 4129 | end; |
|
| - | 4130 | else |
|
| - | 4131 | end; |
|
| - | 4132 | end; |
|
| - | 4133 | end; |
|
| - | 4134 | case BitCount of |
|
| - | 4135 | 8, 4: Temp1.Free; |
|
| - | 4136 | else |
|
| - | 4137 | end; |
|
| - | 4138 | end; |
|
| 2816 | 4139 | ||
| - | 4140 | procedure TDIB.AddRGB(aR, aG, aB: Byte); |
|
| - | 4141 | var |
|
| 2817 | StartProgress('Mirror'); |
4142 | Table: array[0..255] of TBGR; |
| - | 4143 | x, y: Integer; |
|
| 2818 | try |
4144 | i: Byte; |
| - | 4145 | D: pointer; |
|
| - | 4146 | P: PByte; |
|
| - | 4147 | color: DWORD; |
|
| - | 4148 | Temp1: TDIB; |
|
| - | 4149 | R, G, B: Byte; |
|
| - | 4150 | begin |
|
| - | 4151 | color := 0; |
|
| - | 4152 | D := nil; |
|
| - | 4153 | Temp1 := nil; |
|
| - | 4154 | case BitCount of |
|
| 2819 | for y:=0 to Height-1 do |
4155 | 32: Exit; // I haven't bitmap of this type ! Sorry |
| - | 4156 | 24, 16: |
|
| 2820 | begin |
4157 | begin |
| - | 4158 | for i := 0 to 255 do |
|
| - | 4159 | begin |
|
| - | 4160 | Table[i].b := IntToByte(i + aB); |
|
| - | 4161 | Table[i].g := IntToByte(i + aG); |
|
| - | 4162 | Table[i].r := IntToByte(i + aR); |
|
| - | 4163 | end; |
|
| - | 4164 | end; |
|
| - | 4165 | 8, 4: |
|
| - | 4166 | begin |
|
| - | 4167 | Temp1 := TDIB.Create; |
|
| - | 4168 | Temp1.Assign(self); |
|
| - | 4169 | Temp1.SetSize(Width, Height, BitCount); |
|
| - | 4170 | for i := 0 to 255 do |
|
| - | 4171 | begin |
|
| - | 4172 | with ColorTable[i] do |
|
| - | 4173 | begin |
|
| - | 4174 | rgbRed := IntToByte(rgbRed + aR); |
|
| - | 4175 | rgbGreen := IntToByte(rgbGreen + aG); |
|
| - | 4176 | rgbBlue := IntToByte(rgbBlue + aB); |
|
| - | 4177 | end; |
|
| - | 4178 | end; |
|
| - | 4179 | UpdatePalette; |
|
| - | 4180 | end; |
|
| - | 4181 | else |
|
| - | 4182 | // if the number of pixel is equal to 1 then exit of procedure |
|
| - | 4183 | Exit; |
|
| - | 4184 | end; |
|
| - | 4185 | for y := 0 to Pred(Height) do |
|
| - | 4186 | begin |
|
| - | 4187 | case BitCount of |
|
| 2821 | P1 := ScanLine[y]; |
4188 | 24, 16: D := ScanLine[y]; |
| - | 4189 | 8, 4: |
|
| - | 4190 | begin |
|
| - | 4191 | D := Temp1.ScanLine[y]; |
|
| - | 4192 | end; |
|
| - | 4193 | else |
|
| - | 4194 | end; |
|
| - | 4195 | for x := 0 to Pred(Width) do |
|
| - | 4196 | begin |
|
| - | 4197 | case BitCount of |
|
| - | 4198 | 32: ; // I haven't bitmap of this type ! Sorry |
|
| - | 4199 | 24: |
|
| - | 4200 | begin |
|
| - | 4201 | PBGR(D)^.B := Table[PBGR(D)^.B].b; |
|
| - | 4202 | PBGR(D)^.G := Table[PBGR(D)^.G].g; |
|
| - | 4203 | PBGR(D)^.R := Table[PBGR(D)^.R].r; |
|
| - | 4204 | Inc(PBGR(D)); |
|
| - | 4205 | end; |
|
| - | 4206 | 16: |
|
| - | 4207 | begin |
|
| - | 4208 | pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B); |
|
| - | 4209 | PWord(D)^ := Table[R].r + Table[G].g + Table[B].b; |
|
| - | 4210 | Inc(PWord(D)); |
|
| - | 4211 | end; |
|
| - | 4212 | 8: |
|
| - | 4213 | begin |
|
| - | 4214 | Inc(PByte(D)); |
|
| - | 4215 | end; |
|
| - | 4216 | 4: |
|
| - | 4217 | begin |
|
| - | 4218 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4219 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| - | 4220 | end; |
|
| - | 4221 | else |
|
| - | 4222 | end; |
|
| - | 4223 | end; |
|
| - | 4224 | end; |
|
| - | 4225 | case BitCount of |
|
| - | 4226 | 8, 4: Temp1.Free; |
|
| - | 4227 | else |
|
| - | 4228 | end; |
|
| - | 4229 | end; |
|
| 2822 | 4230 | ||
| 2823 | case BitCount of |
4231 | function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean; |
| 2824 | 1 : begin |
4232 | var |
| 2825 | for x:=0 to Width2-1 do |
4233 | Sum, r, g, b, x, y: Integer; |
| 2826 | begin |
4234 | a, i, j: byte; |
| 2827 | c := Pixels[x, y]; |
4235 | tmp: TBGR; |
| 2828 | Pixels[x, y] := Pixels[Width-x-1, y]; |
- | |
| 2829 | Pixels[Width-x-1, y] := c; |
- | |
| 2830 | end; |
4236 | Col: PBGR; |
| 2831 | end; |
4237 | D: Pointer; |
| 2832 | 4 : begin |
4238 | begin |
| 2833 | for x:=0 to Width2-1 do |
- | |
| 2834 | begin |
4239 | Result := True; |
| 2835 | c := Pixels[x, y]; |
4240 | Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] + |
| 2836 | Pixels[x, y] := Pixels[Width-x-1, y]; |
4241 | Filter[0, 1] + Filter[1, 1] + Filter[2, 1] + |
| 2837 | Pixels[Width-x-1, y] := c; |
4242 | Filter[0, 2] + Filter[1, 2] + Filter[2, 2]; |
| 2838 | end; |
4243 | if Sum = 0 then |
| 2839 | end; |
4244 | Sum := 1; |
| 2840 | 8 : begin |
4245 | Col := PBits; |
| 2841 | P2 := Pointer(Integer(P1)+Width-1); |
- | |
| 2842 | for x:=0 to Width2-1 do |
4246 | for y := 0 to Pred(Height) do |
| 2843 | begin |
4247 | begin |
| 2844 | PByte(@c)^ := PByte(P1)^; |
4248 | D := Dest.ScanLine[y]; |
| 2845 | PByte(P1)^ := PByte(P2)^; |
- | |
| 2846 | PByte(P2)^ := PByte(@c)^; |
4249 | for x := 0 to Pred(Width) do |
| 2847 | Inc(PByte(P1)); |
4250 | begin |
| 2848 | Dec(PByte(P2)); |
4251 | r := 0; g := 0; b := 0; |
| 2849 | end; |
4252 | case BitCount of |
| 2850 | end; |
4253 | 32, 16, 4, 1: |
| 2851 | 16: begin |
4254 | begin |
| 2852 | P2 := Pointer(Integer(P1)+(Width-1)*2); |
- | |
| 2853 | for x:=0 to Width2-1 do |
4255 | Result := False; |
| 2854 | begin |
4256 | Exit; |
| 2855 | PWord(@c)^ := PWord(P1)^; |
- | |
| 2856 | PWord(P1)^ := PWord(P2)^; |
- | |
| 2857 | PWord(P2)^ := PWord(@c)^; |
- | |
| 2858 | Inc(PWord(P1)); |
4257 | end; |
| 2859 | Dec(PWord(P2)); |
4258 | 24: |
| 2860 | end; |
4259 | begin |
| 2861 | end; |
4260 | for i := 0 to 2 do |
| 2862 | 24: begin |
4261 | begin |
| 2863 | P2 := Pointer(Integer(P1)+(Width-1)*3); |
- | |
| 2864 | for x:=0 to Width2-1 do |
4262 | for j := 0 to 2 do |
| 2865 | begin |
4263 | begin |
| 2866 | PBGR(@c)^ := PBGR(P1)^; |
4264 | Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
| 2867 | PBGR(P1)^ := PBGR(P2)^; |
4265 | Interval(0, Pred(Height), y + Pred(j), True)]); |
| 2868 | PBGR(P2)^ := PBGR(@c)^; |
4266 | Inc(b, Filter[i, j] * Tmp.b); |
| 2869 | Inc(PBGR(P1)); |
4267 | Inc(g, Filter[i, j] * Tmp.g); |
| 2870 | Dec(PBGR(P2)); |
4268 | Inc(r, Filter[i, j] * Tmp.r); |
| 2871 | end; |
- | |
| 2872 | end; |
4269 | end; |
| 2873 | 32: begin |
4270 | end; |
| - | 4271 | Col.b := IntToByte(b div Sum); |
|
| 2874 | P2 := Pointer(Integer(P1)+(Width-1)*4); |
4272 | Col.g := IntToByte(g div Sum); |
| - | 4273 | Col.r := IntToByte(r div Sum); |
|
| - | 4274 | Dest.Pixels[x, y] := rgb(Col.r, Col.g, Col.b); |
|
| - | 4275 | end; |
|
| - | 4276 | 8: |
|
| - | 4277 | begin |
|
| - | 4278 | for i := 0 to 2 do |
|
| - | 4279 | begin |
|
| 2875 | for x:=0 to Width2-1 do |
4280 | for j := 0 to 2 do |
| 2876 | begin |
4281 | begin |
| - | 4282 | a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
|
| - | 4283 | Interval(0, Pred(Height), y + Pred(j), True)]); |
|
| 2877 | PDWORD(@c)^ := PDWORD(P1)^; |
4284 | tmp.r := ColorTable[a].rgbRed; |
| 2878 | PDWORD(P1)^ := PDWORD(P2)^; |
4285 | tmp.g := ColorTable[a].rgbGreen; |
| 2879 | PDWORD(P2)^ := PDWORD(@c)^; |
4286 | tmp.b := ColorTable[a].rgbBlue; |
| 2880 | Inc(PDWORD(P1)); |
4287 | Inc(b, Filter[i, j] * Tmp.b); |
| 2881 | Dec(PDWORD(P2)); |
4288 | Inc(g, Filter[i, j] * Tmp.g); |
| 2882 | end; |
4289 | Inc(r, Filter[i, j] * Tmp.r); |
| 2883 | end; |
4290 | end; |
| 2884 | end; |
4291 | end; |
| 2885 | - | ||
| - | 4292 | Col.b := IntToByte(b div Sum); |
|
| - | 4293 | Col.g := IntToByte(g div Sum); |
|
| - | 4294 | Col.r := IntToByte(r div Sum); |
|
| - | 4295 | PByte(D)^ := rgb(Col.r, Col.g, Col.b); |
|
| 2886 | UpdateProgress(y); |
4296 | Inc(PByte(D)); |
| - | 4297 | end; |
|
| 2887 | end; |
4298 | end; |
| 2888 | finally |
- | |
| 2889 | EndProgress; |
- | |
| 2890 | end; |
4299 | end; |
| - | 4300 | end; |
|
| - | 4301 | end; |
|
| - | 4302 | ||
| - | 4303 | procedure TDIB.Spray(Amount: Integer); |
|
| - | 4304 | var |
|
| - | 4305 | value, x, y: Integer; |
|
| - | 4306 | D: Pointer; |
|
| - | 4307 | color: DWORD; |
|
| - | 4308 | P: PByte; |
|
| - | 4309 | begin |
|
| 2891 | end else if (MirrorX) and (MirrorY) then |
4310 | for y := Pred(Height) downto 0 do |
| 2892 | begin |
4311 | begin |
| - | 4312 | D := ScanLine[y]; |
|
| - | 4313 | for x := 0 to Pred(Width) do |
|
| - | 4314 | begin |
|
| - | 4315 | value := Random(Amount); |
|
| - | 4316 | color := Pixels[Interval(0, Pred(Width), x + (value - Random(value * 2)), True), |
|
| - | 4317 | Interval(0, Pred(Height), y + (value - Random(value * 2)), True)]; |
|
| - | 4318 | case BitCount of |
|
| - | 4319 | 32: |
|
| - | 4320 | begin |
|
| - | 4321 | PDWord(D)^ := color; |
|
| - | 4322 | Inc(PDWord(D)); |
|
| - | 4323 | end; |
|
| - | 4324 | 24: |
|
| - | 4325 | begin |
|
| - | 4326 | PBGR(D)^ := IntToColor(color); |
|
| - | 4327 | Inc(PBGR(D)); |
|
| - | 4328 | end; |
|
| - | 4329 | 16: |
|
| - | 4330 | begin |
|
| - | 4331 | PWord(D)^ := color; |
|
| 2893 | StartProgress('Mirror'); |
4332 | Inc(PWord(D)); |
| - | 4333 | end; |
|
| 2894 | try |
4334 | 8: |
| - | 4335 | begin |
|
| 2895 | for y:=0 to Height shr 1-1 do |
4336 | PByte(D)^ := color; |
| - | 4337 | Inc(PByte(D)); |
|
| - | 4338 | end; |
|
| - | 4339 | 4: |
|
| - | 4340 | begin |
|
| - | 4341 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4342 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| - | 4343 | end; |
|
| - | 4344 | 1: |
|
| - | 4345 | begin |
|
| - | 4346 | P := @PArrayByte(D)[X shr 3]; |
|
| - | 4347 | P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
|
| - | 4348 | end; |
|
| - | 4349 | else |
|
| - | 4350 | end; |
|
| - | 4351 | end; |
|
| - | 4352 | end; |
|
| - | 4353 | end; |
|
| - | 4354 | ||
| - | 4355 | procedure TDIB.Sharpen(Amount: Integer); |
|
| - | 4356 | var |
|
| - | 4357 | Lin0, Lin1, Lin2: PLines; |
|
| - | 4358 | pc: PBGR; |
|
| - | 4359 | cx, x, y: Integer; |
|
| - | 4360 | Buf: array[0..8] of TBGR; |
|
| - | 4361 | D: pointer; |
|
| - | 4362 | c: DWORD; |
|
| - | 4363 | i: byte; |
|
| - | 4364 | P1: PByte; |
|
| - | 4365 | Temp1: TDIB; |
|
| - | 4366 | ||
| - | 4367 | begin |
|
| - | 4368 | D := nil; |
|
| - | 4369 | GetMem(pc, SizeOf(TBGR)); |
|
| - | 4370 | c := 0; |
|
| - | 4371 | Temp1 := nil; |
|
| - | 4372 | case Bitcount of |
|
| - | 4373 | 32, 16, 1: Exit; |
|
| - | 4374 | 24: |
|
| 2896 | begin |
4375 | begin |
| 2897 | P1 := ScanLine[y]; |
4376 | Temp1 := TDIB.Create; |
| - | 4377 | Temp1.Assign(self); |
|
| - | 4378 | Temp1.SetSize(Width, Height, bitCount); |
|
| - | 4379 | end; |
|
| - | 4380 | 8: |
|
| - | 4381 | begin |
|
| 2898 | P2 := ScanLine[Height-y-1]; |
4382 | Temp1 := TDIB.Create; |
| - | 4383 | Temp1.Assign(self); |
|
| - | 4384 | Temp1.SetSize(Width, Height, bitCount); |
|
| - | 4385 | for i := 0 to 255 do |
|
| - | 4386 | begin |
|
| - | 4387 | with Temp1.ColorTable[i] do |
|
| - | 4388 | begin |
|
| - | 4389 | Buf[0].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4390 | Buf[0].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4391 | Buf[0].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4392 | Buf[1].B := ColorTable[i].rgbBlue; |
|
| - | 4393 | Buf[1].G := ColorTable[i].rgbGreen; |
|
| - | 4394 | Buf[1].R := ColorTable[i].rgbRed; |
|
| - | 4395 | Buf[2].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4396 | Buf[2].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4397 | Buf[2].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4398 | Buf[3].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4399 | Buf[3].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4400 | Buf[3].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4401 | Buf[4].B := ColorTable[i].rgbBlue; |
|
| - | 4402 | Buf[4].G := ColorTable[i].rgbGreen; |
|
| - | 4403 | Buf[4].R := ColorTable[i].rgbRed; |
|
| - | 4404 | Buf[5].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4405 | Buf[5].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4406 | Buf[5].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4407 | Buf[6].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4408 | Buf[6].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4409 | Buf[6].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4410 | Buf[7].B := ColorTable[i].rgbBlue; |
|
| - | 4411 | Buf[7].G := ColorTable[i].rgbGreen; |
|
| - | 4412 | Buf[7].R := ColorTable[i].rgbRed; |
|
| - | 4413 | Buf[8].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4414 | Buf[8].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4415 | Buf[8].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4416 | Temp1.colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
|
| - | 4417 | Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
|
| - | 4418 | Temp1.colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
|
| - | 4419 | Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
|
| - | 4420 | Temp1.colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
|
| - | 4421 | Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
|
| 2899 | 4422 | ||
| 2900 | case BitCount of |
- | |
| 2901 | 1 : begin |
- | |
| 2902 | for x:=0 to Width-1 do |
- | |
| 2903 | begin |
- | |
| 2904 | c := Pixels[x, y]; |
- | |
| 2905 | Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
- | |
| 2906 | Pixels[Width-x-1, Height-y-1] := c; |
- | |
| 2907 | end; |
- | |
| 2908 | end; |
- | |
| 2909 | 4 : begin |
- | |
| 2910 | for x:=0 to Width-1 do |
- | |
| 2911 | begin |
- | |
| 2912 | c := Pixels[x, y]; |
- | |
| 2913 | Pixels[x, y] := Pixels[Width-x-1, Height-y-1]; |
- | |
| 2914 | Pixels[Width-x-1, Height-y-1] := c; |
- | |
| 2915 | end; |
- | |
| 2916 | end; |
- | |
| 2917 | 8 : begin |
- | |
| 2918 | P2 := Pointer(Integer(P2)+Width-1); |
- | |
| 2919 | for x:=0 to Width-1 do |
- | |
| 2920 | begin |
- | |
| 2921 | PByte(@c)^ := PByte(P1)^; |
- | |
| 2922 | PByte(P1)^ := PByte(P2)^; |
- | |
| 2923 | PByte(P2)^ := PByte(@c)^; |
- | |
| 2924 | Inc(PByte(P1)); |
- | |
| 2925 | Dec(PByte(P2)); |
- | |
| 2926 | end; |
- | |
| 2927 | end; |
- | |
| 2928 | 16: begin |
- | |
| 2929 | P2 := Pointer(Integer(P2)+(Width-1)*2); |
- | |
| 2930 | for x:=0 to Width-1 do |
- | |
| 2931 | begin |
- | |
| 2932 | PWord(@c)^ := PWord(P1)^; |
- | |
| 2933 | PWord(P1)^ := PWord(P2)^; |
- | |
| 2934 | PWord(P2)^ := PWord(@c)^; |
- | |
| 2935 | Inc(PWord(P1)); |
- | |
| 2936 | Dec(PWord(P2)); |
- | |
| 2937 | end; |
- | |
| 2938 | end; |
- | |
| 2939 | 24: begin |
- | |
| 2940 | P2 := Pointer(Integer(P2)+(Width-1)*3); |
- | |
| 2941 | for x:=0 to Width-1 do |
- | |
| 2942 | begin |
- | |
| 2943 | PBGR(@c)^ := PBGR(P1)^; |
- | |
| 2944 | PBGR(P1)^ := PBGR(P2)^; |
- | |
| 2945 | PBGR(P2)^ := PBGR(@c)^; |
- | |
| 2946 | Inc(PBGR(P1)); |
- | |
| 2947 | Dec(PBGR(P2)); |
- | |
| 2948 | end; |
- | |
| 2949 | end; |
- | |
| 2950 | 32: begin |
- | |
| 2951 | P2 := Pointer(Integer(P2)+(Width-1)*4); |
- | |
| 2952 | for x:=0 to Width-1 do |
- | |
| 2953 | begin |
- | |
| 2954 | PDWORD(@c)^ := PDWORD(P1)^; |
- | |
| 2955 | PDWORD(P1)^ := PDWORD(P2)^; |
- | |
| 2956 | PDWORD(P2)^ := PDWORD(@c)^; |
- | |
| 2957 | Inc(PDWORD(P1)); |
- | |
| 2958 | Dec(PDWORD(P2)); |
- | |
| 2959 | end; |
- | |
| 2960 | end; |
4423 | end; |
| 2961 | end; |
4424 | end; |
| - | 4425 | Temp1.UpdatePalette; |
|
| - | 4426 | end; |
|
| 2962 | 4427 | 4: |
|
| - | 4428 | begin |
|
| - | 4429 | Temp1 := TDIB.Create; |
|
| - | 4430 | Temp1.Assign(self); |
|
| - | 4431 | Temp1.SetSize(Width, Height, bitCount); |
|
| - | 4432 | for i := 0 to 255 do |
|
| - | 4433 | begin |
|
| - | 4434 | with Temp1.ColorTable[i] do |
|
| - | 4435 | begin |
|
| - | 4436 | Buf[0].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4437 | Buf[0].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4438 | Buf[0].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4439 | Buf[1].B := ColorTable[i].rgbBlue; |
|
| - | 4440 | Buf[1].G := ColorTable[i].rgbGreen; |
|
| - | 4441 | Buf[1].R := ColorTable[i].rgbRed; |
|
| - | 4442 | Buf[2].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4443 | Buf[2].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4444 | Buf[2].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4445 | Buf[3].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4446 | Buf[3].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4447 | Buf[3].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4448 | Buf[4].B := ColorTable[i].rgbBlue; |
|
| - | 4449 | Buf[4].G := ColorTable[i].rgbGreen; |
|
| - | 4450 | Buf[4].R := ColorTable[i].rgbRed; |
|
| - | 4451 | Buf[5].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4452 | Buf[5].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4453 | Buf[5].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4454 | Buf[6].B := ColorTable[i - Amount].rgbBlue; |
|
| - | 4455 | Buf[6].G := ColorTable[i - Amount].rgbGreen; |
|
| - | 4456 | Buf[6].R := ColorTable[i - Amount].rgbRed; |
|
| - | 4457 | Buf[7].B := ColorTable[i].rgbBlue; |
|
| - | 4458 | Buf[7].G := ColorTable[i].rgbGreen; |
|
| - | 4459 | Buf[7].R := ColorTable[i].rgbRed; |
|
| - | 4460 | Buf[8].B := ColorTable[i + Amount].rgbBlue; |
|
| - | 4461 | Buf[8].G := ColorTable[i + Amount].rgbGreen; |
|
| - | 4462 | Buf[8].R := ColorTable[i + Amount].rgbRed; |
|
| - | 4463 | colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
|
| - | 4464 | Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
|
| - | 4465 | colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
|
| - | 4466 | Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
|
| - | 4467 | colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
|
| - | 4468 | Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
|
| - | 4469 | end; |
|
| - | 4470 | end; |
|
| 2963 | UpdateProgress(y*2); |
4471 | UpdatePalette; |
| - | 4472 | end; |
|
| - | 4473 | end; |
|
| - | 4474 | for y := 0 to Pred(Height) do |
|
| - | 4475 | begin |
|
| - | 4476 | Lin0 := ScanLine[Interval(0, Pred(Height), y - Amount, True)]; |
|
| - | 4477 | Lin1 := ScanLine[y]; |
|
| - | 4478 | Lin2 := ScanLine[Interval(0, Pred(Height), y + Amount, True)]; |
|
| - | 4479 | case Bitcount of |
|
| - | 4480 | 24, 8, 4: D := Temp1.ScanLine[y]; |
|
| - | 4481 | end; |
|
| - | 4482 | for x := 0 to Pred(Width) do |
|
| - | 4483 | begin |
|
| - | 4484 | case BitCount of |
|
| - | 4485 | 24: |
|
| - | 4486 | begin |
|
| - | 4487 | cx := Interval(0, Pred(Width), x - Amount, True); |
|
| - | 4488 | Buf[0] := Lin0[cx]; |
|
| - | 4489 | Buf[1] := Lin1[cx]; |
|
| - | 4490 | Buf[2] := Lin2[cx]; |
|
| - | 4491 | Buf[3] := Lin0[x]; |
|
| - | 4492 | Buf[4] := Lin1[x]; |
|
| - | 4493 | Buf[5] := Lin2[x]; |
|
| - | 4494 | cx := Interval(0, Pred(Width), x + Amount, true); |
|
| - | 4495 | Buf[6] := Lin0[cx]; |
|
| - | 4496 | Buf[7] := Lin1[cx]; |
|
| - | 4497 | Buf[8] := Lin0[cx]; |
|
| - | 4498 | pc.b := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b + |
|
| - | 4499 | Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128); |
|
| - | 4500 | pc.g := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g + |
|
| - | 4501 | Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128); |
|
| - | 4502 | pc.r := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r + |
|
| - | 4503 | Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128); |
|
| - | 4504 | PBGR(D)^.B := pc.b; |
|
| - | 4505 | PBGR(D)^.G := pc.g; |
|
| - | 4506 | PBGR(D)^.R := pc.r; |
|
| - | 4507 | Inc(PBGR(D)); |
|
| - | 4508 | end; |
|
| - | 4509 | 8: |
|
| - | 4510 | begin |
|
| - | 4511 | Inc(PByte(D)); |
|
| - | 4512 | end; |
|
| - | 4513 | 4: |
|
| - | 4514 | begin |
|
| - | 4515 | P1 := @PArrayByte(D)[X shr 1]; |
|
| - | 4516 | P1^ := ((P1^ and Mask4n[X and 1]) or ((c shl Shift4[X and 1]))); |
|
| - | 4517 | end; |
|
| 2964 | end; |
4518 | end; |
| 2965 | finally |
- | |
| 2966 | EndProgress; |
- | |
| 2967 | end; |
4519 | end; |
| 2968 | end; |
4520 | end; |
| - | 4521 | case BitCount of |
|
| - | 4522 | 24, 8: |
|
| - | 4523 | begin |
|
| - | 4524 | Assign(Temp1); |
|
| - | 4525 | Temp1.Free; |
|
| - | 4526 | end; |
|
| - | 4527 | 4: Temp1.Free; |
|
| - | 4528 | end; |
|
| - | 4529 | FreeMem(pc, SizeOf(TBGR)); |
|
| 2969 | end; |
4530 | end; |
| 2970 | 4531 | ||
| 2971 | procedure TDIB.Negative; |
4532 | procedure TDIB.Emboss; |
| 2972 | var |
4533 | var |
| - | 4534 | x, y: longint; |
|
| 2973 | i, i2: Integer; |
4535 | D, D1, P: pointer; |
| - | 4536 | color: TBGR; |
|
| - | 4537 | c: DWORD; |
|
| 2974 | P: Pointer; |
4538 | P1: PByte; |
| - | 4539 | ||
| 2975 | begin |
4540 | begin |
| - | 4541 | D := nil; |
|
| - | 4542 | D1 := nil; |
|
| - | 4543 | P := nil; |
|
| - | 4544 | case BitCount of |
|
| 2976 | if Empty then exit; |
4545 | 32, 16, 1: Exit; |
| - | 4546 | 24: |
|
| - | 4547 | begin |
|
| - | 4548 | D := PBits; |
|
| - | 4549 | D1 := Ptr(Integer(D) + 3); |
|
| - | 4550 | end; |
|
| - | 4551 | else |
|
| - | 4552 | end; |
|
| - | 4553 | for y := 0 to Pred(Height) do |
|
| - | 4554 | begin |
|
| - | 4555 | case Bitcount of |
|
| - | 4556 | 8, 4: |
|
| - | 4557 | begin |
|
| - | 4558 | P := ScanLine[y]; |
|
| - | 4559 | end; |
|
| - | 4560 | end; |
|
| - | 4561 | for x := 0 to Pred(Width) do |
|
| - | 4562 | begin |
|
| - | 4563 | case BitCount of |
|
| - | 4564 | 24: |
|
| - | 4565 | begin |
|
| - | 4566 | PBGR(D)^.B := ((PBGR(D)^.B + (PBGR(D1)^.B xor $FF)) shr 1); |
|
| - | 4567 | PBGR(D)^.G := ((PBGR(D)^.G + (PBGR(D1)^.G xor $FF)) shr 1); |
|
| - | 4568 | PBGR(D)^.R := ((PBGR(D)^.R + (PBGR(D1)^.R xor $FF)) shr 1); |
|
| - | 4569 | Inc(PBGR(D)); |
|
| - | 4570 | if (y < Height - 2) and (x < Width - 2) then |
|
| - | 4571 | Inc(PBGR(D1)); |
|
| - | 4572 | end; |
|
| - | 4573 | 8: |
|
| - | 4574 | begin |
|
| - | 4575 | color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
|
| - | 4576 | color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
|
| - | 4577 | color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3; |
|
| - | 4578 | c := (color.R + color.G + color.B) shr 1; |
|
| - | 4579 | PByte(P)^ := c; |
|
| - | 4580 | Inc(PByte(P)); |
|
| - | 4581 | end; |
|
| - | 4582 | 4: |
|
| - | 4583 | begin |
|
| - | 4584 | color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3; |
|
| - | 4585 | color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) - 1) shr 1) + 30) div 3; |
|
| - | 4586 | color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3; |
|
| - | 4587 | c := (color.R + color.G + color.B) shr 1; |
|
| - | 4588 | if c > 64 then |
|
| - | 4589 | c := c - 8; |
|
| - | 4590 | P1 := @PArrayByte(P)[X shr 1]; |
|
| - | 4591 | P1^ := (P1^ and Mask4n[X and 1]) or ((c) shl Shift4[X and 1]); |
|
| - | 4592 | end; |
|
| - | 4593 | else |
|
| - | 4594 | end; |
|
| - | 4595 | end; |
|
| - | 4596 | case BitCount of |
|
| - | 4597 | 24: |
|
| - | 4598 | begin |
|
| - | 4599 | D := Ptr(Integer(D1)); |
|
| - | 4600 | if y < Height - 2 then |
|
| - | 4601 | D1 := Ptr(Integer(D1) + 6) |
|
| - | 4602 | else |
|
| - | 4603 | D1 := Ptr(Integer(ScanLine[Pred(Height)]) + 3); |
|
| - | 4604 | end; |
|
| - | 4605 | else |
|
| - | 4606 | end; |
|
| - | 4607 | end; |
|
| - | 4608 | end; |
|
| 2977 | 4609 | ||
| - | 4610 | procedure TDIB.AddMonoNoise(Amount: Integer); |
|
| - | 4611 | var |
|
| - | 4612 | value: cardinal; |
|
| 2978 | if BitCount<=8 then |
4613 | x, y: longint; |
| - | 4614 | a: byte; |
|
| - | 4615 | D: pointer; |
|
| - | 4616 | color: DWORD; |
|
| - | 4617 | P: PByte; |
|
| - | 4618 | begin |
|
| - | 4619 | for y := 0 to Pred(Height) do |
|
| 2979 | begin |
4620 | begin |
| - | 4621 | D := ScanLine[y]; |
|
| 2980 | for i:=0 to 255 do |
4622 | for x := 0 to Pred(Width) do |
| - | 4623 | begin |
|
| - | 4624 | case BitCount of |
|
| - | 4625 | 32: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 4626 | 24: |
|
| - | 4627 | begin |
|
| - | 4628 | value := Random(Amount) - (Amount shr 1); |
|
| - | 4629 | PBGR(D)^.B := IntToByte(PBGR(D)^.B + value); |
|
| - | 4630 | PBGR(D)^.G := IntToByte(PBGR(D)^.G + value); |
|
| - | 4631 | PBGR(D)^.R := IntToByte(PBGR(D)^.R + value); |
|
| - | 4632 | Inc(PBGR(D)); |
|
| - | 4633 | end; |
|
| - | 4634 | 16: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 4635 | 8: |
|
| - | 4636 | begin |
|
| - | 4637 | a := ((Random(Amount shr 1) - (Amount div 4))) div 8; |
|
| - | 4638 | color := Interval(0, 255, (pixels[x, y] - a), True); |
|
| - | 4639 | PByte(D)^ := color; |
|
| 2981 | with ColorTable[i] do |
4640 | Inc(PByte(D)); |
| - | 4641 | end; |
|
| - | 4642 | 4: |
|
| - | 4643 | begin |
|
| - | 4644 | a := ((Random(Amount shr 1) - (Amount div 4))) div 16; |
|
| - | 4645 | color := Interval(0, 15, (pixels[x, y] - a), True); |
|
| - | 4646 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4647 | P^ := ((P^ and Mask4n[X and 1]) or ((color shl Shift4[X and 1]))); |
|
| - | 4648 | end; |
|
| - | 4649 | 1: |
|
| - | 4650 | begin |
|
| - | 4651 | a := ((Random(Amount shr 1) - (Amount div 4))) div 32; |
|
| - | 4652 | color := Interval(0, 1, (pixels[x, y] - a), True); |
|
| - | 4653 | P := @PArrayByte(D)[X shr 3]; |
|
| - | 4654 | P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
|
| - | 4655 | end; |
|
| - | 4656 | else |
|
| - | 4657 | end; |
|
| - | 4658 | end; |
|
| - | 4659 | end; |
|
| - | 4660 | end; |
|
| - | 4661 | ||
| - | 4662 | procedure TDIB.AddGradiantNoise(Amount: byte); |
|
| - | 4663 | var |
|
| - | 4664 | a, i: byte; |
|
| - | 4665 | x, y: Integer; |
|
| - | 4666 | Table: array[0..255] of TBGR; |
|
| - | 4667 | S, D: pointer; |
|
| - | 4668 | color: DWORD; |
|
| - | 4669 | Temp1: TDIB; |
|
| - | 4670 | P: PByte; |
|
| - | 4671 | ||
| - | 4672 | begin |
|
| - | 4673 | D := nil; |
|
| - | 4674 | S := nil; |
|
| - | 4675 | Temp1 := nil; |
|
| - | 4676 | case BitCount of |
|
| - | 4677 | 32: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 4678 | 24: |
|
| 2982 | begin |
4679 | begin |
| 2983 | rgbRed := 255-rgbRed; |
4680 | for i := 0 to 255 do |
| - | 4681 | begin |
|
| 2984 | rgbGreen := 255-rgbGreen; |
4682 | a := Random(Amount); |
| - | 4683 | Table[i].b := IntToByte(i + a); |
|
| - | 4684 | Table[i].g := IntToByte(i + a); |
|
| 2985 | rgbBlue := 255-rgbBlue; |
4685 | Table[i].r := IntToByte(i + a); |
| - | 4686 | end; |
|
| 2986 | end; |
4687 | end; |
| - | 4688 | 16: Exit; // I haven't bitmap of this type ! Sorry |
|
| - | 4689 | 8, 4: |
|
| - | 4690 | begin |
|
| - | 4691 | Temp1 := TDIB.Create; |
|
| - | 4692 | Temp1.Assign(self); |
|
| - | 4693 | Temp1.SetSize(Width, Height, BitCount); |
|
| - | 4694 | for i := 0 to 255 do |
|
| - | 4695 | begin |
|
| - | 4696 | with ColorTable[i] do |
|
| - | 4697 | begin |
|
| - | 4698 | a := Random(Amount); |
|
| - | 4699 | rgbRed := IntToByte(rgbRed + a); |
|
| - | 4700 | rgbGreen := IntToByte(rgbGreen + a); |
|
| - | 4701 | rgbBlue := IntToByte(rgbBlue + a); |
|
| - | 4702 | end; |
|
| - | 4703 | end; |
|
| 2987 | UpdatePalette; |
4704 | UpdatePalette; |
| - | 4705 | end; |
|
| 2988 | end else |
4706 | else |
| - | 4707 | // if the number of pixel is equal to 1 then exit of procedure |
|
| - | 4708 | Exit; |
|
| - | 4709 | end; |
|
| - | 4710 | for y := 0 to Pred(Height) do |
|
| 2989 | begin |
4711 | begin |
| - | 4712 | case BitCount of |
|
| - | 4713 | 24: D := ScanLine[y]; |
|
| - | 4714 | 8, 4: |
|
| 2990 | P := PBits; |
4715 | begin |
| - | 4716 | D := Temp1.ScanLine[y]; |
|
| - | 4717 | S := Temp1.ScanLine[y]; |
|
| 2991 | i2 := Size; |
4718 | end; |
| 2992 | asm |
4719 | else |
| - | 4720 | end; |
|
| - | 4721 | for x := 0 to Pred(Width) do |
|
| - | 4722 | begin |
|
| - | 4723 | case BitCount of |
|
| - | 4724 | 32: ; // I haven't bitmap of this type ! Sorry |
|
| - | 4725 | 24: |
|
| - | 4726 | begin |
|
| - | 4727 | PBGR(D)^.B := Table[PBGR(D)^.B].b; |
|
| - | 4728 | PBGR(D)^.G := Table[PBGR(D)^.G].g; |
|
| - | 4729 | PBGR(D)^.R := Table[PBGR(D)^.R].r; |
|
| - | 4730 | Inc(PBGR(D)); |
|
| - | 4731 | end; |
|
| - | 4732 | 16: ; // I haven't bitmap of this type ! Sorry |
|
| - | 4733 | 8: |
|
| 2993 | mov ecx,i2 |
4734 | begin |
| - | 4735 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4736 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4737 | Inc(PByte(S)); |
|
| - | 4738 | PByte(D)^ := color; |
|
| - | 4739 | Inc(PByte(D)); |
|
| 2994 | mov eax,P |
4740 | end; |
| - | 4741 | 4: |
|
| - | 4742 | begin |
|
| - | 4743 | with Temp1.ColorTable[PByte(S)^] do |
|
| - | 4744 | color := rgbRed + rgbGreen + rgbBlue; |
|
| - | 4745 | Inc(PByte(S)); |
|
| - | 4746 | P := @PArrayByte(D)[X shr 1]; |
|
| - | 4747 | P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]); |
|
| 2995 | mov edx,ecx |
4748 | end; |
| - | 4749 | else |
|
| - | 4750 | end; |
|
| - | 4751 | end; |
|
| - | 4752 | end; |
|
| - | 4753 | case BitCount of |
|
| - | 4754 | 8, 4: Temp1.Free; |
|
| - | 4755 | else |
|
| - | 4756 | end; |
|
| - | 4757 | end; |
|
| 2996 | 4758 | ||
| - | 4759 | function TDIB.FishEye(bmp: TDIB): Boolean; |
|
| - | 4760 | var |
|
| - | 4761 | weight, xmid, ymid, fx, fy, r1, r2, dx, dy, rmax: Double; |
|
| - | 4762 | Amount, ifx, ify, ty, tx, new_red, new_green, new_blue, ix, iy: Integer; |
|
| - | 4763 | weight_x, weight_y: array[0..1] of Double; |
|
| - | 4764 | total_red, total_green, total_blue: Double; |
|
| - | 4765 | sli, slo: PLines; |
|
| - | 4766 | D: Pointer; |
|
| - | 4767 | begin |
|
| - | 4768 | Result := True; |
|
| - | 4769 | case BitCount of |
|
| - | 4770 | 32, 16, 8, 4, 1: |
|
| - | 4771 | begin |
|
| - | 4772 | Result := False; |
|
| - | 4773 | Exit; |
|
| - | 4774 | end; |
|
| - | 4775 | end; |
|
| - | 4776 | Amount := 1; |
|
| - | 4777 | xmid := Width / 2; |
|
| - | 4778 | ymid := Height / 2; |
|
| - | 4779 | rmax := Max(Bmp.Width, Bmp.Height) * Amount; |
|
| - | 4780 | for ty := 0 to Pred(Height) do |
|
| - | 4781 | begin |
|
| - | 4782 | for tx := 0 to Pred(Width) do |
|
| - | 4783 | begin |
|
| - | 4784 | dx := tx - xmid; |
|
| - | 4785 | dy := ty - ymid; |
|
| - | 4786 | r1 := Sqrt(Sqr(dx) + Sqr(dy)); |
|
| - | 4787 | if r1 <> 0 then |
|
| - | 4788 | begin |
|
| - | 4789 | r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1); |
|
| - | 4790 | fx := dx * r2 / r1 + xmid; |
|
| - | 4791 | fy := dy * r2 / r1 + ymid; |
|
| - | 4792 | end |
|
| - | 4793 | else |
|
| - | 4794 | begin |
|
| - | 4795 | fx := xmid; |
|
| - | 4796 | fy := ymid; |
|
| - | 4797 | end; |
|
| - | 4798 | ify := Trunc(fy); |
|
| - | 4799 | ifx := Trunc(fx); |
|
| - | 4800 | if fy >= 0 then |
|
| - | 4801 | begin |
|
| - | 4802 | weight_y[1] := fy - ify; |
|
| - | 4803 | weight_y[0] := 1 - weight_y[1]; |
|
| - | 4804 | end |
|
| - | 4805 | else |
|
| - | 4806 | begin |
|
| - | 4807 | weight_y[0] := -(fy - ify); |
|
| - | 4808 | weight_y[1] := 1 - weight_y[0]; |
|
| - | 4809 | end; |
|
| - | 4810 | if fx >= 0 then |
|
| - | 4811 | begin |
|
| - | 4812 | weight_x[1] := fx - ifx; |
|
| - | 4813 | weight_x[0] := 1 - weight_x[1]; |
|
| - | 4814 | end |
|
| - | 4815 | else |
|
| - | 4816 | begin |
|
| - | 4817 | weight_x[0] := -(fx - ifx); |
|
| - | 4818 | Weight_x[1] := 1 - weight_x[0]; |
|
| - | 4819 | end; |
|
| - | 4820 | if ifx < 0 then |
|
| - | 4821 | ifx := Pred(Width) - (-ifx mod Width) |
|
| - | 4822 | else |
|
| - | 4823 | if ifx > Pred(Width) then |
|
| - | 4824 | ifx := ifx mod Width; |
|
| - | 4825 | if ify < 0 then |
|
| - | 4826 | ify := Pred(Height) - (-ify mod Height) |
|
| - | 4827 | else |
|
| - | 4828 | if ify > Pred(Height) then |
|
| - | 4829 | ify := ify mod Height; |
|
| - | 4830 | total_red := 0.0; |
|
| - | 4831 | total_green := 0.0; |
|
| - | 4832 | total_blue := 0.0; |
|
| 2997 | { Unit of DWORD. } |
4833 | for ix := 0 to 1 do |
| - | 4834 | begin |
|
| - | 4835 | for iy := 0 to 1 do |
|
| - | 4836 | begin |
|
| - | 4837 | if ify + iy < Height then |
|
| - | 4838 | sli := ScanLine[ify + iy] |
|
| - | 4839 | else |
|
| - | 4840 | sli := ScanLine[Height - ify - iy]; |
|
| - | 4841 | if ifx + ix < Width then |
|
| - | 4842 | begin |
|
| - | 4843 | new_red := sli^[ifx + ix].r; |
|
| - | 4844 | new_green := sli^[ifx + ix].g; |
|
| - | 4845 | new_blue := sli^[ifx + ix].b; |
|
| - | 4846 | end |
|
| - | 4847 | else |
|
| 2998 | @@qword_skip: |
4848 | begin |
| - | 4849 | new_red := sli^[Width - ifx - ix].r; |
|
| - | 4850 | new_green := sli^[Width - ifx - ix].g; |
|
| - | 4851 | new_blue := sli^[Width - ifx - ix].b; |
|
| 2999 | shr ecx,2 |
4852 | end; |
| - | 4853 | weight := weight_x[ix] * weight_y[iy]; |
|
| - | 4854 | total_red := total_red + new_red * weight; |
|
| - | 4855 | total_green := total_green + new_green * weight; |
|
| - | 4856 | total_blue := total_blue + new_blue * weight; |
|
| - | 4857 | end; |
|
| - | 4858 | end; |
|
| 3000 | jz @@dword_skip |
4859 | case bitCount of |
| - | 4860 | 24: |
|
| - | 4861 | begin |
|
| - | 4862 | slo := Bmp.ScanLine[ty]; |
|
| - | 4863 | slo^[tx].r := Round(total_red); |
|
| - | 4864 | slo^[tx].g := Round(total_green); |
|
| - | 4865 | slo^[tx].b := Round(total_blue); |
|
| - | 4866 | end; |
|
| - | 4867 | else |
|
| - | 4868 | // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
|
| - | 4869 | Exit; |
|
| - | 4870 | end; |
|
| - | 4871 | end; |
|
| - | 4872 | end; |
|
| - | 4873 | end; |
|
| 3001 | 4874 | ||
| - | 4875 | function TDIB.SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean; |
|
| - | 4876 | var |
|
| - | 4877 | weight, Theta, cosTheta, sinTheta, sfrom_y, sfrom_x: Double; |
|
| - | 4878 | ifrom_y, ifrom_x, xDiff, yDiff, to_y, to_x: Integer; |
|
| - | 4879 | weight_x, weight_y: array[0..1] of Double; |
|
| - | 4880 | ix, iy, new_red, new_green, new_blue: Integer; |
|
| - | 4881 | total_red, total_green, total_blue: Double; |
|
| - | 4882 | sli, slo: PLines; |
|
| - | 4883 | begin |
|
| - | 4884 | Result := True; |
|
| - | 4885 | case BitCount of |
|
| - | 4886 | 32, 16, 8, 4, 1: |
|
| - | 4887 | begin |
|
| - | 4888 | Result := False; |
|
| - | 4889 | Exit; |
|
| - | 4890 | end; |
|
| - | 4891 | end; |
|
| - | 4892 | Theta := -Degree * Pi / 180; |
|
| - | 4893 | sinTheta := Sin(Theta); |
|
| - | 4894 | cosTheta := Cos(Theta); |
|
| - | 4895 | xDiff := (Bmp.Width - Width) div 2; |
|
| - | 4896 | yDiff := (Bmp.Height - Height) div 2; |
|
| - | 4897 | for to_y := 0 to Pred(Bmp.Height) do |
|
| - | 4898 | begin |
|
| - | 4899 | for to_x := 0 to Pred(Bmp.Width) do |
|
| - | 4900 | begin |
|
| - | 4901 | sfrom_x := (cx + (to_x - cx) * cosTheta - (to_y - cy) * sinTheta) - xDiff; |
|
| - | 4902 | ifrom_x := Trunc(sfrom_x); |
|
| - | 4903 | sfrom_y := (cy + (to_x - cx) * sinTheta + (to_y - cy) * cosTheta) - yDiff; |
|
| - | 4904 | ifrom_y := Trunc(sfrom_y); |
|
| - | 4905 | if sfrom_y >= 0 then |
|
| - | 4906 | begin |
|
| - | 4907 | weight_y[1] := sfrom_y - ifrom_y; |
|
| - | 4908 | weight_y[0] := 1 - weight_y[1]; |
|
| - | 4909 | end |
|
| - | 4910 | else |
|
| - | 4911 | begin |
|
| - | 4912 | weight_y[0] := -(sfrom_y - ifrom_y); |
|
| - | 4913 | weight_y[1] := 1 - weight_y[0]; |
|
| - | 4914 | end; |
|
| - | 4915 | if sfrom_x >= 0 then |
|
| - | 4916 | begin |
|
| - | 4917 | weight_x[1] := sfrom_x - ifrom_x; |
|
| - | 4918 | weight_x[0] := 1 - weight_x[1]; |
|
| - | 4919 | end |
|
| - | 4920 | else |
|
| - | 4921 | begin |
|
| - | 4922 | weight_x[0] := -(sfrom_x - ifrom_x); |
|
| - | 4923 | Weight_x[1] := 1 - weight_x[0]; |
|
| - | 4924 | end; |
|
| - | 4925 | if ifrom_x < 0 then |
|
| - | 4926 | ifrom_x := Pred(Width) - (-ifrom_x mod Width) |
|
| - | 4927 | else |
|
| - | 4928 | if ifrom_x > Pred(Width) then |
|
| - | 4929 | ifrom_x := ifrom_x mod Width; |
|
| - | 4930 | if ifrom_y < 0 then |
|
| - | 4931 | ifrom_y := Pred(Height) - (-ifrom_y mod Height) |
|
| 3002 | dec ecx |
4932 | else |
| - | 4933 | if ifrom_y > Pred(Height) then |
|
| - | 4934 | ifrom_y := ifrom_y mod Height; |
|
| - | 4935 | total_red := 0.0; |
|
| - | 4936 | total_green := 0.0; |
|
| - | 4937 | total_blue := 0.0; |
|
| - | 4938 | for ix := 0 to 1 do |
|
| - | 4939 | begin |
|
| - | 4940 | for iy := 0 to 1 do |
|
| - | 4941 | begin |
|
| - | 4942 | if ifrom_y + iy < Height then |
|
| - | 4943 | sli := ScanLine[ifrom_y + iy] |
|
| 3003 | @@dword_loop: |
4944 | else |
| - | 4945 | sli := ScanLine[Height - ifrom_y - iy]; |
|
| - | 4946 | if ifrom_x + ix < Width then |
|
| - | 4947 | begin |
|
| 3004 | not dword ptr [eax+ecx*4] |
4948 | new_red := sli^[ifrom_x + ix].r; |
| - | 4949 | new_green := sli^[ifrom_x + ix].g; |
|
| - | 4950 | new_blue := sli^[ifrom_x + ix].b; |
|
| 3005 | dec ecx |
4951 | end |
| - | 4952 | else |
|
| - | 4953 | begin |
|
| - | 4954 | new_red := sli^[Width - ifrom_x - ix].r; |
|
| - | 4955 | new_green := sli^[Width - ifrom_x - ix].g; |
|
| - | 4956 | new_blue := sli^[Width - ifrom_x - ix].b; |
|
| - | 4957 | end; |
|
| - | 4958 | weight := weight_x[ix] * weight_y[iy]; |
|
| - | 4959 | total_red := total_red + new_red * weight; |
|
| - | 4960 | total_green := total_green + new_green * weight; |
|
| - | 4961 | total_blue := total_blue + new_blue * weight; |
|
| - | 4962 | end; |
|
| - | 4963 | end; |
|
| 3006 | jnl @@dword_loop |
4964 | case bitCount of |
| - | 4965 | 24: |
|
| - | 4966 | begin |
|
| - | 4967 | slo := Bmp.ScanLine[to_y]; |
|
| - | 4968 | slo^[to_x].r := Round(total_red); |
|
| - | 4969 | slo^[to_x].g := Round(total_green); |
|
| - | 4970 | slo^[to_x].b := Round(total_blue); |
|
| - | 4971 | end; |
|
| - | 4972 | else |
|
| - | 4973 | // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
|
| - | 4974 | Exit; |
|
| - | 4975 | end; |
|
| - | 4976 | end; |
|
| - | 4977 | end; |
|
| - | 4978 | end; |
|
| 3007 | 4979 | ||
| - | 4980 | function TDIB.Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean; |
|
| - | 4981 | var |
|
| - | 4982 | x, y, dx, dy, sdx, sdy, xDiff, yDiff, isinTheta, icosTheta: Integer; |
|
| - | 4983 | D, S: Pointer; |
|
| - | 4984 | sinTheta, cosTheta, Theta: Double; |
|
| - | 4985 | Col: TBGR; |
|
| - | 4986 | i: byte; |
|
| - | 4987 | color: DWORD; |
|
| - | 4988 | P: PByte; |
|
| - | 4989 | begin |
|
| - | 4990 | D := nil; |
|
| - | 4991 | S := nil; |
|
| - | 4992 | Result := True; |
|
| - | 4993 | dst.SetSize(Width, Height, Bitcount); |
|
| - | 4994 | dst.Canvas.Brush.Color := clBlack; |
|
| - | 4995 | Dst.Canvas.FillRect(Bounds(0, 0, Width, Height)); |
|
| - | 4996 | case BitCount of |
|
| - | 4997 | 32, 16: |
|
| - | 4998 | begin |
|
| - | 4999 | Result := False; |
|
| 3008 | mov ecx,edx |
5000 | Exit; |
| - | 5001 | end; |
|
| - | 5002 | 8, 4, 1: |
|
| - | 5003 | begin |
|
| - | 5004 | for i := 0 to 255 do |
|
| - | 5005 | Dst.ColorTable[i] := ColorTable[i]; |
|
| - | 5006 | Dst.UpdatePalette; |
|
| - | 5007 | end; |
|
| - | 5008 | end; |
|
| - | 5009 | Theta := -Angle * Pi / 180; |
|
| - | 5010 | sinTheta := Sin(Theta); |
|
| - | 5011 | cosTheta := Cos(Theta); |
|
| - | 5012 | xDiff := (Dst.Width - Width) div 2; |
|
| - | 5013 | yDiff := (Dst.Height - Height) div 2; |
|
| - | 5014 | isinTheta := Round(sinTheta * $10000); |
|
| - | 5015 | icosTheta := Round(cosTheta * $10000); |
|
| - | 5016 | for y := 0 to Pred(Dst.Height) do |
|
| - | 5017 | begin |
|
| - | 5018 | case BitCount of |
|
| - | 5019 | 4, 1: |
|
| - | 5020 | begin |
|
| - | 5021 | D := Dst.ScanLine[y]; |
|
| - | 5022 | S := ScanLine[y]; |
|
| 3009 | shr ecx,2 |
5023 | end; |
| - | 5024 | else |
|
| - | 5025 | end; |
|
| - | 5026 | sdx := Round(((cx + (-cx) * cosTheta - (y - cy) * sinTheta) - xDiff) * $10000); |
|
| - | 5027 | sdy := Round(((cy + (-cy) * sinTheta + (y - cy) * cosTheta) - yDiff) * $10000); |
|
| - | 5028 | for x := 0 to Pred(Dst.Width) do |
|
| - | 5029 | begin |
|
| - | 5030 | dx := (sdx shr 16); |
|
| - | 5031 | dy := (sdy shr 16); |
|
| - | 5032 | if (dx > -1) and (dx < Width) and (dy > -1) and (dy < Height) then |
|
| - | 5033 | begin |
|
| - | 5034 | case bitcount of |
|
| - | 5035 | 8, 24: Dst.pixels[x, y] := Pixels[dx, dy]; |
|
| - | 5036 | 4: |
|
| - | 5037 | begin |
|
| - | 5038 | pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b); |
|
| - | 5039 | color := col.r + col.g + col.b; |
|
| - | 5040 | Inc(PByte(S)); |
|
| - | 5041 | P := @PArrayByte(D)[x shr 1]; |
|
| - | 5042 | P^ := (P^ and Mask4n[x and 1]) or (color shl Shift4[x and 1]); |
|
| - | 5043 | end; |
|
| - | 5044 | 1: |
|
| 3010 | add eax,ecx*4 |
5045 | begin |
| - | 5046 | pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b); |
|
| - | 5047 | color := col.r + col.g + col.b; |
|
| - | 5048 | Inc(PByte(S)); |
|
| - | 5049 | P := @PArrayByte(D)[X shr 3]; |
|
| - | 5050 | P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]); |
|
| - | 5051 | end; |
|
| - | 5052 | end; |
|
| - | 5053 | end; |
|
| - | 5054 | Inc(sdx, icosTheta); |
|
| - | 5055 | Inc(sdy, isinTheta); |
|
| - | 5056 | end; |
|
| - | 5057 | end; |
|
| - | 5058 | end; |
|
| 3011 | 5059 | ||
| 3012 | { Unit of Byte. } |
5060 | procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer); |
| 3013 | @@dword_skip: |
5061 | var |
| 3014 | mov ecx,edx |
5062 | i: Integer; |
| - | 5063 | begin |
|
| 3015 | and ecx,3 |
5064 | for i := 1 to Amount do |
| 3016 | jz @@byte_skip |
5065 | Bmp.SplitBlur(i); |
| - | 5066 | end; |
|
| 3017 | 5067 | ||
| - | 5068 | procedure TDIB.SplitBlur(Amount: Integer); |
|
| - | 5069 | var |
|
| 3018 | dec ecx |
5070 | Lin1, Lin2: PLines; |
| 3019 | @@loop_byte: |
5071 | cx, x, y: Integer; |
| 3020 | not byte ptr [eax+ecx] |
5072 | Buf: array[0..3] of TBGR; |
| 3021 | dec ecx |
5073 | D: Pointer; |
| 3022 | jnl @@loop_byte |
- | |
| 3023 | 5074 | ||
| - | 5075 | begin |
|
| - | 5076 | case Bitcount of |
|
| - | 5077 | 32, 16, 8, 4, 1: Exit; |
|
| - | 5078 | end; |
|
| - | 5079 | for y := 0 to Pred(Height) do |
|
| - | 5080 | begin |
|
| - | 5081 | Lin1 := ScanLine[TrimInt(y + Amount, 0, Pred(Height))]; |
|
| - | 5082 | Lin2 := ScanLine[TrimInt(y - Amount, 0, Pred(Height))]; |
|
| - | 5083 | D := ScanLine[y]; |
|
| - | 5084 | for x := 0 to Pred(Width) do |
|
| 3024 | @@byte_skip: |
5085 | begin |
| - | 5086 | cx := TrimInt(x + Amount, 0, Pred(Width)); |
|
| - | 5087 | Buf[0] := Lin1[cx]; |
|
| - | 5088 | Buf[1] := Lin2[cx]; |
|
| - | 5089 | cx := TrimInt(x - Amount, 0, Pred(Width)); |
|
| - | 5090 | Buf[2] := Lin1[cx]; |
|
| - | 5091 | Buf[3] := Lin2[cx]; |
|
| - | 5092 | PBGR(D)^.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2; |
|
| - | 5093 | PBGR(D)^.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2; |
|
| - | 5094 | PBGR(D)^.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2; |
|
| - | 5095 | Inc(PBGR(D)); |
|
| 3025 | end; |
5096 | end; |
| 3026 | end; |
5097 | end; |
| 3027 | end; |
5098 | end; |
| 3028 | 5099 | ||
| - | 5100 | function TDIB.Twist(bmp: TDIB; Amount: byte): Boolean; |
|
| - | 5101 | var |
|
| - | 5102 | fxmid, fymid: Single; |
|
| - | 5103 | txmid, tymid: Single; |
|
| - | 5104 | fx, fy: Single; |
|
| - | 5105 | tx2, ty2: Single; |
|
| - | 5106 | r: Single; |
|
| - | 5107 | theta: Single; |
|
| - | 5108 | ifx, ify: Integer; |
|
| - | 5109 | dx, dy: Single; |
|
| - | 5110 | OFFSET: Single; |
|
| - | 5111 | ty, tx, ix, iy: Integer; |
|
| - | 5112 | weight_x, weight_y: array[0..1] of Single; |
|
| - | 5113 | weight: Single; |
|
| - | 5114 | new_red, new_green, new_blue: Integer; |
|
| - | 5115 | total_red, total_green, total_blue: Single; |
|
| - | 5116 | sli, slo: PLines; |
|
| - | 5117 | ||
| - | 5118 | function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 5119 | begin |
|
| - | 5120 | if xt = 0 then |
|
| - | 5121 | if yt > 0 then |
|
| - | 5122 | Result := Pi / 2 |
|
| - | 5123 | else |
|
| - | 5124 | Result := -(Pi / 2) |
|
| - | 5125 | else |
|
| - | 5126 | begin |
|
| - | 5127 | Result := ArcTan(yt / xt); |
|
| - | 5128 | if xt < 0 then |
|
| - | 5129 | Result := Pi + ArcTan(yt / xt); |
|
| - | 5130 | end; |
|
| - | 5131 | end; |
|
| - | 5132 | ||
| - | 5133 | begin |
|
| - | 5134 | Result := True; |
|
| - | 5135 | case BitCount of |
|
| - | 5136 | 32, 16, 8, 4, 1: |
|
| - | 5137 | begin |
|
| - | 5138 | Result := False; |
|
| - | 5139 | Exit; |
|
| - | 5140 | end; |
|
| - | 5141 | end; |
|
| - | 5142 | if Amount = 0 then |
|
| - | 5143 | Amount := 1; |
|
| - | 5144 | OFFSET := -(Pi / 2); |
|
| - | 5145 | dx := Pred(Width); |
|
| - | 5146 | dy := Pred(Height); |
|
| - | 5147 | r := Sqrt(dx * dx + dy * dy); |
|
| - | 5148 | tx2 := r; |
|
| - | 5149 | ty2 := r; |
|
| - | 5150 | txmid := (Pred(Width)) / 2; |
|
| - | 5151 | tymid := (Pred(Height)) / 2; |
|
| - | 5152 | fxmid := (Pred(Width)) / 2; |
|
| - | 5153 | fymid := (Pred(Height)) / 2; |
|
| - | 5154 | if tx2 >= Width then |
|
| - | 5155 | tx2 := Pred(Width); |
|
| - | 5156 | if ty2 >= Height then |
|
| - | 5157 | ty2 := Pred(Height); |
|
| - | 5158 | for ty := 0 to Round(ty2) do |
|
| - | 5159 | begin |
|
| - | 5160 | for tx := 0 to Round(tx2) do |
|
| - | 5161 | begin |
|
| - | 5162 | dx := tx - txmid; |
|
| - | 5163 | dy := ty - tymid; |
|
| - | 5164 | r := Sqrt(dx * dx + dy * dy); |
|
| - | 5165 | if r = 0 then |
|
| - | 5166 | begin |
|
| - | 5167 | fx := 0; |
|
| - | 5168 | fy := 0; |
|
| - | 5169 | end |
|
| - | 5170 | else |
|
| - | 5171 | begin |
|
| - | 5172 | theta := ArcTan2(dx, dy) - r / Amount - OFFSET; |
|
| - | 5173 | fx := r * Cos(theta); |
|
| - | 5174 | fy := r * Sin(theta); |
|
| - | 5175 | end; |
|
| - | 5176 | fx := fx + fxmid; |
|
| - | 5177 | fy := fy + fymid; |
|
| - | 5178 | ify := Trunc(fy); |
|
| - | 5179 | ifx := Trunc(fx); |
|
| - | 5180 | if fy >= 0 then |
|
| - | 5181 | begin |
|
| - | 5182 | weight_y[1] := fy - ify; |
|
| - | 5183 | weight_y[0] := 1 - weight_y[1]; |
|
| - | 5184 | end |
|
| - | 5185 | else |
|
| - | 5186 | begin |
|
| - | 5187 | weight_y[0] := -(fy - ify); |
|
| - | 5188 | weight_y[1] := 1 - weight_y[0]; |
|
| - | 5189 | end; |
|
| - | 5190 | if fx >= 0 then |
|
| - | 5191 | begin |
|
| - | 5192 | weight_x[1] := fx - ifx; |
|
| - | 5193 | weight_x[0] := 1 - weight_x[1]; |
|
| - | 5194 | end |
|
| - | 5195 | else |
|
| - | 5196 | begin |
|
| - | 5197 | weight_x[0] := -(fx - ifx); |
|
| - | 5198 | Weight_x[1] := 1 - weight_x[0]; |
|
| - | 5199 | end; |
|
| - | 5200 | if ifx < 0 then |
|
| - | 5201 | ifx := Pred(Width) - (-ifx mod Width) |
|
| - | 5202 | else |
|
| - | 5203 | if ifx > Pred(Width) then |
|
| - | 5204 | ifx := ifx mod Width; |
|
| - | 5205 | if ify < 0 then |
|
| - | 5206 | ify := Pred(Height) - (-ify mod Height) |
|
| - | 5207 | else |
|
| - | 5208 | if ify > Pred(Height) then |
|
| - | 5209 | ify := ify mod Height; |
|
| - | 5210 | total_red := 0.0; |
|
| - | 5211 | total_green := 0.0; |
|
| - | 5212 | total_blue := 0.0; |
|
| - | 5213 | for ix := 0 to 1 do |
|
| - | 5214 | begin |
|
| - | 5215 | for iy := 0 to 1 do |
|
| - | 5216 | begin |
|
| - | 5217 | if ify + iy < Height then |
|
| - | 5218 | sli := ScanLine[ify + iy] |
|
| - | 5219 | else |
|
| - | 5220 | sli := ScanLine[Height - ify - iy]; |
|
| - | 5221 | if ifx + ix < Width then |
|
| - | 5222 | begin |
|
| - | 5223 | new_red := sli^[ifx + ix].r; |
|
| - | 5224 | new_green := sli^[ifx + ix].g; |
|
| - | 5225 | new_blue := sli^[ifx + ix].b; |
|
| - | 5226 | end |
|
| - | 5227 | else |
|
| - | 5228 | begin |
|
| - | 5229 | new_red := sli^[Width - ifx - ix].r; |
|
| - | 5230 | new_green := sli^[Width - ifx - ix].g; |
|
| - | 5231 | new_blue := sli^[Width - ifx - ix].b; |
|
| - | 5232 | end; |
|
| - | 5233 | weight := weight_x[ix] * weight_y[iy]; |
|
| - | 5234 | total_red := total_red + new_red * weight; |
|
| - | 5235 | total_green := total_green + new_green * weight; |
|
| - | 5236 | total_blue := total_blue + new_blue * weight; |
|
| - | 5237 | end; |
|
| - | 5238 | end; |
|
| - | 5239 | case bitCount of |
|
| - | 5240 | 24: |
|
| - | 5241 | begin |
|
| - | 5242 | slo := bmp.ScanLine[ty]; |
|
| - | 5243 | slo^[tx].r := Round(total_red); |
|
| - | 5244 | slo^[tx].g := Round(total_green); |
|
| - | 5245 | slo^[tx].b := Round(total_blue); |
|
| - | 5246 | end; |
|
| - | 5247 | else |
|
| - | 5248 | // You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB |
|
| - | 5249 | Exit; |
|
| - | 5250 | end; |
|
| - | 5251 | end; |
|
| - | 5252 | end; |
|
| - | 5253 | end; |
|
| - | 5254 | ||
| - | 5255 | function TDIB.TrimInt(i, Min, Max: Integer): Integer; |
|
| - | 5256 | begin |
|
| - | 5257 | if i > Max then |
|
| - | 5258 | Result := Max |
|
| - | 5259 | else |
|
| - | 5260 | if i < Min then |
|
| - | 5261 | Result := Min |
|
| - | 5262 | else |
|
| - | 5263 | Result := i; |
|
| - | 5264 | end; |
|
| - | 5265 | ||
| - | 5266 | function TDIB.IntToByte(i: Integer): Byte; |
|
| - | 5267 | begin |
|
| - | 5268 | if i > 255 then |
|
| - | 5269 | Result := 255 |
|
| - | 5270 | else |
|
| - | 5271 | if i < 0 then |
|
| - | 5272 | Result := 0 |
|
| - | 5273 | else |
|
| - | 5274 | Result := i; |
|
| - | 5275 | end; |
|
| - | 5276 | ||
| - | 5277 | //-------------------------------------------------------------------------------------------------- |
|
| - | 5278 | // End of these New Special Effect // |
|
| - | 5279 | // Please contributes to add effects and filters to this collection // |
|
| - | 5280 | // Please, work to implement 32,16,8,4,2 BitCount's DIB // |
|
| - | 5281 | // Have fun - Mickey - Good job // |
|
| - | 5282 | //-------------------------------------------------------------------------------------------------- |
|
| - | 5283 | ||
| - | 5284 | function TDIB.GetAlphaChannel: TDIB; |
|
| - | 5285 | begin |
|
| - | 5286 | RetAlphaChannel(Result); |
|
| - | 5287 | ||
| - | 5288 | FFreeList.Add(Result); |
|
| - | 5289 | end; |
|
| - | 5290 | ||
| - | 5291 | procedure TDIB.SetAlphaChannel(const Value: TDIB); |
|
| - | 5292 | begin |
|
| - | 5293 | if not AssignAlphaChannel(Value{$IFNDEF VER4UP}, False{$ENDIF}) then |
|
| - | 5294 | Exception.Create('Cannot set alphachannel from DIB.'); |
|
| - | 5295 | end; |
|
| - | 5296 | ||
| - | 5297 | procedure TDIB.Fill(aColor: TColor); |
|
| - | 5298 | begin |
|
| - | 5299 | Canvas.Brush.Color := aColor; |
|
| - | 5300 | Canvas.FillRect(ClientRect); |
|
| - | 5301 | end; |
|
| - | 5302 | ||
| - | 5303 | function TDIB.GetClientRect: TRect; |
|
| - | 5304 | begin |
|
| - | 5305 | Result := Bounds(0, 0, Width, Height); |
|
| - | 5306 | end; |
|
| - | 5307 | ||
| 3029 | { TCustomDXDIB } |
5308 | { TCustomDXDIB } |
| 3030 | 5309 | ||
| 3031 | constructor TCustomDXDIB.Create(AOnwer: TComponent); |
5310 | constructor TCustomDXDIB.Create(AOnwer: TComponent); |
| 3032 | begin |
5311 | begin |
| 3033 | inherited Create(AOnwer); |
5312 | inherited Create(AOnwer); |
| Line 3070... | Line 5349... | ||
| 3070 | 5349 | ||
| 3071 | procedure TCustomDXPaintBox.Paint; |
5350 | procedure TCustomDXPaintBox.Paint; |
| 3072 | 5351 | ||
| 3073 | procedure Draw2(Width, Height: Integer); |
5352 | procedure Draw2(Width, Height: Integer); |
| 3074 | begin |
5353 | begin |
| 3075 | if (Width<>FDIB.Width) or (Height<>FDIB.Height) then |
5354 | if (Width <> FDIB.Width) or (Height <> FDIB.Height) then |
| 3076 | begin |
5355 | begin |
| 3077 | if FCenter then |
5356 | if FCenter then |
| 3078 | begin |
5357 | begin |
| 3079 | inherited Canvas.StretchDraw(Bounds(-(Width-ClientWidth) div 2, |
5358 | inherited Canvas.StretchDraw(Bounds(-(Width - ClientWidth) div 2, |
| 3080 | -(Height-ClientHeight) div 2, Width, Height), FDIB); |
5359 | -(Height - ClientHeight) div 2, Width, Height), FDIB); |
| - | 5360 | end |
|
| 3081 | end else |
5361 | else |
| 3082 | begin |
5362 | begin |
| 3083 | inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB); |
5363 | inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB); |
| 3084 | end; |
5364 | end; |
| - | 5365 | end |
|
| 3085 | end else |
5366 | else |
| 3086 | begin |
5367 | begin |
| 3087 | if FCenter then |
5368 | if FCenter then |
| 3088 | begin |
5369 | begin |
| 3089 | inherited Canvas.Draw(-(Width-ClientWidth) div 2, -(Height-ClientHeight) div 2, |
5370 | inherited Canvas.Draw(-(Width - ClientWidth) div 2, -(Height - ClientHeight) div 2, |
| 3090 | FDIB); |
5371 | FDIB); |
| - | 5372 | end |
|
| 3091 | end else |
5373 | else |
| 3092 | begin |
5374 | begin |
| 3093 | inherited Canvas.Draw(0, 0, FDIB); |
5375 | inherited Canvas.Draw(0, 0, FDIB); |
| 3094 | end; |
5376 | end; |
| 3095 | end; |
5377 | end; |
| 3096 | end; |
5378 | end; |
| Line 3110... | Line 5392... | ||
| 3110 | Rectangle(0, 0, Width, Height); |
5392 | Rectangle(0, 0, Width, Height); |
| 3111 | end; |
5393 | end; |
| 3112 | 5394 | ||
| 3113 | if FDIB.Empty then Exit; |
5395 | if FDIB.Empty then Exit; |
| 3114 | 5396 | ||
| 3115 | if (FViewWidth>0) or (FViewHeight>0) then |
5397 | if (FViewWidth > 0) or (FViewHeight > 0) then |
| 3116 | begin |
5398 | begin |
| 3117 | ViewWidth2 := FViewWidth; |
5399 | ViewWidth2 := FViewWidth; |
| 3118 | if ViewWidth2=0 then ViewWidth2 := FDIB.Width; |
5400 | if ViewWidth2 = 0 then ViewWidth2 := FDIB.Width; |
| 3119 | ViewHeight2 := FViewHeight; |
5401 | ViewHeight2 := FViewHeight; |
| 3120 | if ViewHeight2=0 then ViewHeight2 := FDIB.Height; |
5402 | if ViewHeight2 = 0 then ViewHeight2 := FDIB.Height; |
| 3121 | 5403 | ||
| 3122 | if FAutoStretch then |
5404 | if FAutoStretch then |
| 3123 | begin |
5405 | begin |
| 3124 | if (ClientWidth<ViewWidth2) or (ClientHeight<ViewHeight2) then |
5406 | if (ClientWidth < ViewWidth2) or (ClientHeight < ViewHeight2) then |
| 3125 | begin |
5407 | begin |
| 3126 | r := ViewWidth2/ClientWidth; |
5408 | r := ViewWidth2 / ClientWidth; |
| 3127 | r2 := ViewHeight2/ClientHeight; |
5409 | r2 := ViewHeight2 / ClientHeight; |
| 3128 | if r>r2 then |
5410 | if r > r2 then |
| 3129 | r := r2; |
5411 | r := r2; |
| 3130 | Draw2(Round(r*ClientWidth), Round(r*ClientHeight)); |
5412 | Draw2(Round(r * ClientWidth), Round(r * ClientHeight)); |
| - | 5413 | end |
|
| 3131 | end else |
5414 | else |
| 3132 | Draw2(ViewWidth2, ViewHeight2); |
5415 | Draw2(ViewWidth2, ViewHeight2); |
| - | 5416 | end |
|
| 3133 | end else |
5417 | else |
| 3134 | Draw2(ViewWidth2, ViewHeight2); |
5418 | Draw2(ViewWidth2, ViewHeight2); |
| - | 5419 | end |
|
| 3135 | end else |
5420 | else |
| 3136 | begin |
5421 | begin |
| 3137 | if FAutoStretch then |
5422 | if FAutoStretch then |
| 3138 | begin |
5423 | begin |
| 3139 | if (FDIB.Width>ClientWidth) or (FDIB.Height>ClientHeight) then |
5424 | if (FDIB.Width > ClientWidth) or (FDIB.Height > ClientHeight) then |
| 3140 | begin |
5425 | begin |
| 3141 | r := ClientWidth/FDIB.Width; |
5426 | r := ClientWidth / FDIB.Width; |
| 3142 | r2 := ClientHeight/FDIB.Height; |
5427 | r2 := ClientHeight / FDIB.Height; |
| 3143 | if r>r2 then |
5428 | if r > r2 then |
| 3144 | r := r2; |
5429 | r := r2; |
| 3145 | Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height)); |
5430 | Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
| - | 5431 | end |
|
| 3146 | end else |
5432 | else |
| 3147 | Draw2(FDIB.Width, FDIB.Height); |
5433 | Draw2(FDIB.Width, FDIB.Height); |
| 3148 | end else |
5434 | end |
| 3149 | if FStretch then |
- | |
| 3150 | begin |
5435 | else |
| 3151 | if FKeepAspect then |
5436 | if FStretch then |
| 3152 | begin |
5437 | begin |
| - | 5438 | if FKeepAspect then |
|
| - | 5439 | begin |
|
| 3153 | r := ClientWidth/FDIB.Width; |
5440 | r := ClientWidth / FDIB.Width; |
| 3154 | r2 := ClientHeight/FDIB.Height; |
5441 | r2 := ClientHeight / FDIB.Height; |
| 3155 | if r>r2 then |
5442 | if r > r2 then |
| 3156 | r := r2; |
5443 | r := r2; |
| 3157 | Draw2(Round(r*FDIB.Width), Round(r*FDIB.Height)); |
5444 | Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
| - | 5445 | end |
|
| 3158 | end else |
5446 | else |
| 3159 | Draw2(ClientWidth, ClientHeight); |
5447 | Draw2(ClientWidth, ClientHeight); |
| - | 5448 | end |
|
| 3160 | end else |
5449 | else |
| 3161 | Draw2(FDIB.Width, FDIB.Height); |
5450 | Draw2(FDIB.Width, FDIB.Height); |
| 3162 | end; |
5451 | end; |
| 3163 | end; |
5452 | end; |
| 3164 | end; |
5453 | end; |
| 3165 | 5454 | ||
| 3166 | procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean); |
5455 | procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean); |
| 3167 | begin |
5456 | begin |
| 3168 | if FAutoStretch<>Value then |
5457 | if FAutoStretch <> Value then |
| 3169 | begin |
5458 | begin |
| 3170 | FAutoStretch := Value; |
5459 | FAutoStretch := Value; |
| 3171 | Invalidate; |
5460 | Invalidate; |
| 3172 | end; |
5461 | end; |
| 3173 | end; |
5462 | end; |
| 3174 | 5463 | ||
| 3175 | procedure TCustomDXPaintBox.SetCenter(Value: Boolean); |
5464 | procedure TCustomDXPaintBox.SetCenter(Value: Boolean); |
| 3176 | begin |
5465 | begin |
| 3177 | if FCenter<>Value then |
5466 | if FCenter <> Value then |
| 3178 | begin |
5467 | begin |
| 3179 | FCenter := Value; |
5468 | FCenter := Value; |
| 3180 | Invalidate; |
5469 | Invalidate; |
| 3181 | end; |
5470 | end; |
| 3182 | end; |
5471 | end; |
| 3183 | 5472 | ||
| 3184 | procedure TCustomDXPaintBox.SetDIB(Value: TDIB); |
5473 | procedure TCustomDXPaintBox.SetDIB(Value: TDIB); |
| 3185 | begin |
5474 | begin |
| 3186 | if FDIB<>Value then |
5475 | if FDIB <> Value then |
| 3187 | begin |
5476 | begin |
| 3188 | FDIB.Assign(Value); |
5477 | FDIB.Assign(Value); |
| 3189 | Invalidate; |
5478 | Invalidate; |
| 3190 | end; |
5479 | end; |
| 3191 | end; |
5480 | end; |
| 3192 | 5481 | ||
| 3193 | procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean); |
5482 | procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean); |
| 3194 | begin |
5483 | begin |
| 3195 | if Value<>FKeepAspect then |
5484 | if Value <> FKeepAspect then |
| 3196 | begin |
5485 | begin |
| 3197 | FKeepAspect := Value; |
5486 | FKeepAspect := Value; |
| 3198 | Invalidate; |
5487 | Invalidate; |
| 3199 | end; |
5488 | end; |
| 3200 | end; |
5489 | end; |
| 3201 | 5490 | ||
| 3202 | procedure TCustomDXPaintBox.SetStretch(Value: Boolean); |
5491 | procedure TCustomDXPaintBox.SetStretch(Value: Boolean); |
| 3203 | begin |
5492 | begin |
| 3204 | if Value<>FStretch then |
5493 | if Value <> FStretch then |
| 3205 | begin |
5494 | begin |
| 3206 | FStretch := Value; |
5495 | FStretch := Value; |
| 3207 | Invalidate; |
5496 | Invalidate; |
| 3208 | end; |
5497 | end; |
| 3209 | end; |
5498 | end; |
| 3210 | 5499 | ||
| 3211 | procedure TCustomDXPaintBox.SetViewWidth(Value: Integer); |
5500 | procedure TCustomDXPaintBox.SetViewWidth(Value: Integer); |
| 3212 | begin |
5501 | begin |
| 3213 | if Value<0 then Value := 0; |
5502 | if Value < 0 then Value := 0; |
| 3214 | if Value<>FViewWidth then |
5503 | if Value <> FViewWidth then |
| 3215 | begin |
5504 | begin |
| 3216 | FViewWidth := Value; |
5505 | FViewWidth := Value; |
| 3217 | Invalidate; |
5506 | Invalidate; |
| 3218 | end; |
5507 | end; |
| 3219 | end; |
5508 | end; |
| 3220 | 5509 | ||
| 3221 | procedure TCustomDXPaintBox.SetViewHeight(Value: Integer); |
5510 | procedure TCustomDXPaintBox.SetViewHeight(Value: Integer); |
| 3222 | begin |
5511 | begin |
| 3223 | if Value<0 then Value := 0; |
5512 | if Value < 0 then Value := 0; |
| 3224 | if Value<>FViewHeight then |
5513 | if Value <> FViewHeight then |
| 3225 | begin |
5514 | begin |
| 3226 | FViewHeight := Value; |
5515 | FViewHeight := Value; |
| 3227 | Invalidate; |
5516 | Invalidate; |
| 3228 | end; |
5517 | end; |
| 3229 | end; |
5518 | end; |
| 3230 | 5519 | ||
| - | 5520 | { DXFusion -> } |
|
| - | 5521 | ||
| - | 5522 | function PosValue(Value: Integer): Integer; |
|
| - | 5523 | begin |
|
| - | 5524 | if Value < 0 then result := 0 else result := Value; |
|
| - | 5525 | end; |
|
| - | 5526 | ||
| - | 5527 | procedure TDIB.CreateDIBFromBitmap(const Bitmap: TBitmap); |
|
| - | 5528 | var |
|
| - | 5529 | pf: Integer; |
|
| - | 5530 | begin |
|
| - | 5531 | if Bitmap.PixelFormat = pf32bit then pf := 32 else pf := 24; |
|
| - | 5532 | SetSize(Bitmap.Width, Bitmap.Height, pf); {always >=24} |
|
| - | 5533 | Canvas.Draw(0, 0, Bitmap); |
|
| - | 5534 | end; |
|
| - | 5535 | ||
| - | 5536 | function TDIB.CreateBitmapFromDIB: TBitmap; |
|
| - | 5537 | //var |
|
| - | 5538 | // X, Y: Integer; |
|
| - | 5539 | begin |
|
| - | 5540 | Result := TBitmap.Create; |
|
| - | 5541 | if BitCount = 32 then |
|
| - | 5542 | Result.PixelFormat := pf32bit |
|
| - | 5543 | else if BitCount = 24 then |
|
| - | 5544 | Result.PixelFormat := pf24bit |
|
| - | 5545 | else if BitCount = 16 then |
|
| - | 5546 | Result.PixelFormat := pf16bit |
|
| - | 5547 | else if BitCount = 8 then |
|
| - | 5548 | Result.PixelFormat := pf8bit |
|
| - | 5549 | else Result.PixelFormat := pf24bit; |
|
| - | 5550 | Result.Width := Width; |
|
| - | 5551 | Result.Height := Height; |
|
| - | 5552 | Result.Canvas.Draw(0, 0, Self); |
|
| - | 5553 | // for Y := 0 to Height - 1 do |
|
| - | 5554 | // for X := 0 to Width - 1 do |
|
| - | 5555 | // Result.Canvas.Pixels[X, Y] := Canvas.Pixels[X, Y]; |
|
| - | 5556 | end; |
|
| - | 5557 | ||
| - | 5558 | procedure TDIB.DrawTo(SrcDIB: TDIB; X, Y, Width, Height, |
|
| - | 5559 | SourceX, SourceY: Integer); |
|
| - | 5560 | begin |
|
| - | 5561 | SrcDIB.DrawOn(Rect(X, Y, Width, Height), Self.Canvas, SourceX, SourceY); |
|
| - | 5562 | end; |
|
| - | 5563 | ||
| - | 5564 | procedure TDIB.DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 5565 | SourceX, SourceY: Integer; const Color: TColor); |
|
| - | 5566 | var |
|
| - | 5567 | i, j: Integer; |
|
| - | 5568 | k1, k2: Integer; |
|
| - | 5569 | n: Integer; |
|
| - | 5570 | p1, p2: PByteArray; |
|
| - | 5571 | ||
| - | 5572 | Startk1, Startk2: Integer; |
|
| - | 5573 | ||
| - | 5574 | StartY: Integer; |
|
| - | 5575 | EndY: Integer; |
|
| - | 5576 | ||
| - | 5577 | DestStartY: Integer; |
|
| - | 5578 | begin |
|
| - | 5579 | if Self.BitCount <> 24 then Exit; |
|
| - | 5580 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5581 | Startk1 := 3 * SourceX; |
|
| - | 5582 | Startk2 := 3 * X; |
|
| - | 5583 | ||
| - | 5584 | DestStartY := Y - SourceY; |
|
| - | 5585 | ||
| - | 5586 | StartY := SourceY; |
|
| - | 5587 | EndY := SourceY + Height; |
|
| - | 5588 | ||
| - | 5589 | if (StartY + DestStartY < 0) then |
|
| - | 5590 | StartY := -DestStartY; |
|
| - | 5591 | if (EndY + DestStartY > Self.Height) then |
|
| - | 5592 | EndY := Self.Height - DestStartY; |
|
| - | 5593 | ||
| - | 5594 | if (StartY < 0) then |
|
| - | 5595 | StartY := 0; |
|
| - | 5596 | if (EndY > SrcDIB.Height) then |
|
| - | 5597 | EndY := SrcDIB.Height; |
|
| - | 5598 | ||
| - | 5599 | for j := StartY to EndY - 1 do |
|
| - | 5600 | begin |
|
| - | 5601 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 5602 | p2 := SrcDIB.Scanline[j]; |
|
| - | 5603 | ||
| - | 5604 | k1 := Startk1; |
|
| - | 5605 | k2 := Startk2; |
|
| - | 5606 | ||
| - | 5607 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 5608 | begin |
|
| - | 5609 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 5610 | ||
| - | 5611 | if not (n = Color) then |
|
| - | 5612 | begin |
|
| - | 5613 | p1[k2] := p2[k1]; |
|
| - | 5614 | p1[k2 + 1] := p2[k1 + 1]; |
|
| - | 5615 | p1[k2 + 2] := p2[k1 + 2]; |
|
| - | 5616 | end; |
|
| - | 5617 | ||
| - | 5618 | k1 := k1 + 3; |
|
| - | 5619 | k2 := k2 + 3; |
|
| - | 5620 | end; |
|
| - | 5621 | end; |
|
| - | 5622 | end; |
|
| - | 5623 | ||
| - | 5624 | procedure TDIB.DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, |
|
| - | 5625 | Frame: Integer; FilterMode: TFilterMode); |
|
| - | 5626 | var |
|
| - | 5627 | i, j: Integer; |
|
| - | 5628 | p1, p2: PByte; |
|
| - | 5629 | FW: Integer; |
|
| - | 5630 | begin |
|
| - | 5631 | if Self.BitCount <> 24 then Exit; |
|
| - | 5632 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5633 | ||
| - | 5634 | FW := Frame * Width; |
|
| - | 5635 | for i := 1 to Height - 1 do |
|
| - | 5636 | begin |
|
| - | 5637 | p1 := Self.Scanline[i + Y]; |
|
| - | 5638 | p2 := SrcDIB.Scanline[i]; |
|
| - | 5639 | Inc(p1, 3 * (X + 1)); |
|
| - | 5640 | Inc(p2, 3 * (FW + 1)); |
|
| - | 5641 | for j := 1 to Width - 1 do |
|
| - | 5642 | begin |
|
| - | 5643 | if (p2^ = 0) then |
|
| - | 5644 | begin |
|
| - | 5645 | case FilterMode of |
|
| - | 5646 | fmNormal, fmMix50: |
|
| - | 5647 | begin |
|
| - | 5648 | p1^ := p1^ shr 1; // Blue |
|
| - | 5649 | Inc(p1); |
|
| - | 5650 | p1^ := p1^ shr 1; // Green |
|
| - | 5651 | Inc(p1); |
|
| - | 5652 | p1^ := p1^ shr 1; // Red |
|
| - | 5653 | Inc(p1); |
|
| - | 5654 | end; |
|
| - | 5655 | fmMix25: |
|
| - | 5656 | begin |
|
| - | 5657 | p1^ := p1^ - p1^ shr 2; // Blue |
|
| - | 5658 | Inc(p1); |
|
| - | 5659 | p1^ := p1^ - p1^ shr 2; // Green |
|
| - | 5660 | Inc(p1); |
|
| - | 5661 | p1^ := p1^ - p1^ shr 2; // Red |
|
| - | 5662 | Inc(p1); |
|
| - | 5663 | end; |
|
| - | 5664 | fmMix75: |
|
| - | 5665 | begin |
|
| - | 5666 | p1^ := p1^ shr 2; // Blue |
|
| - | 5667 | Inc(p1); |
|
| - | 5668 | p1^ := p1^ shr 2; // Green |
|
| - | 5669 | Inc(p1); |
|
| - | 5670 | p1^ := p1^ shr 2; // Red |
|
| - | 5671 | Inc(p1); |
|
| - | 5672 | end; |
|
| - | 5673 | end; |
|
| - | 5674 | end |
|
| - | 5675 | else |
|
| - | 5676 | Inc(p1, 3); // Not in the loop... |
|
| - | 5677 | Inc(p2, 3); |
|
| - | 5678 | end; |
|
| - | 5679 | end; |
|
| - | 5680 | end; |
|
| - | 5681 | ||
| - | 5682 | procedure TDIB.DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, |
|
| - | 5683 | Frame: Integer; Alpha: Byte); |
|
| - | 5684 | {plynule nastavovani stiny dle alpha} |
|
| - | 5685 | type |
|
| - | 5686 | P3ByteArray = ^T3ByteArray; |
|
| - | 5687 | T3ByteArray = array[0..32767] of TBGR; |
|
| - | 5688 | var |
|
| - | 5689 | i, j, l1, l2: Integer; |
|
| - | 5690 | p1, p2: P3ByteArray; |
|
| - | 5691 | FW: Integer; |
|
| - | 5692 | begin |
|
| - | 5693 | if Self.BitCount <> 24 then Exit; |
|
| - | 5694 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5695 | ||
| - | 5696 | FW := Frame * Width; |
|
| - | 5697 | for i := 0 to Height - 1 do |
|
| - | 5698 | begin |
|
| - | 5699 | p1 := Self.Scanline[i + Y]; |
|
| - | 5700 | p2 := SrcDIB.Scanline[i]; |
|
| - | 5701 | l1 := X; |
|
| - | 5702 | l2 := FW; |
|
| - | 5703 | for j := 0 to Width - 1 do |
|
| - | 5704 | begin |
|
| - | 5705 | if (p2[j + l2].B = 0) and (p2[j + l2].G = 0) and (p2[j + l2].R = 0) then |
|
| - | 5706 | begin |
|
| - | 5707 | p1[J + l1].B := Round(p1[J + l1].B / $FF * Alpha); |
|
| - | 5708 | p1[J + l1].G := Round(p1[J + l1].G / $FF * Alpha); |
|
| - | 5709 | p1[J + l1].R := Round(p1[J + l1].R / $FF * Alpha); |
|
| - | 5710 | end |
|
| - | 5711 | end; |
|
| - | 5712 | end; |
|
| - | 5713 | end; |
|
| - | 5714 | ||
| - | 5715 | procedure TDIB.DrawDarken(SrcDIB: TDIB; X, Y, Width, Height, |
|
| - | 5716 | Frame: Integer); |
|
| - | 5717 | var |
|
| - | 5718 | frameoffset, i, j: Integer; |
|
| - | 5719 | p1, p2: pByte; |
|
| - | 5720 | XOffset: Integer; |
|
| - | 5721 | begin |
|
| - | 5722 | if Self.BitCount <> 24 then Exit; |
|
| - | 5723 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5724 | ||
| - | 5725 | frameoffset := 3 * (Frame * Width) + 3; |
|
| - | 5726 | XOffset := 3 * X + 3; |
|
| - | 5727 | for i := 1 to Height - 1 do |
|
| - | 5728 | begin |
|
| - | 5729 | p1 := Self.Scanline[i + Y]; |
|
| - | 5730 | p2 := SrcDIB.Scanline[i]; |
|
| - | 5731 | inc(p1, XOffset); |
|
| - | 5732 | inc(p2, frameoffset); |
|
| - | 5733 | for j := 1 to Width - 1 do |
|
| - | 5734 | begin |
|
| - | 5735 | p1^ := (p2^ * p1^) shr 8; // R |
|
| - | 5736 | inc(p1); |
|
| - | 5737 | inc(p2); |
|
| - | 5738 | p1^ := (p2^ * p1^) shr 8; // G |
|
| - | 5739 | inc(p1); |
|
| - | 5740 | inc(p2); |
|
| - | 5741 | p1^ := (p2^ * p1^) shr 8; // B |
|
| - | 5742 | inc(p1); |
|
| - | 5743 | inc(p2); |
|
| - | 5744 | end; |
|
| - | 5745 | end; |
|
| - | 5746 | end; |
|
| - | 5747 | ||
| - | 5748 | procedure TDIB.DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 5749 | SourceX, SourceY: Integer; const Color: TColor; FilterMode: TFilterMode); |
|
| - | 5750 | var |
|
| - | 5751 | i, j: Integer; |
|
| - | 5752 | k1, k2: Integer; |
|
| - | 5753 | n: Integer; |
|
| - | 5754 | p1, p2: PByteArray; |
|
| - | 5755 | BitSwitch1, BitSwitch2: Boolean; |
|
| - | 5756 | ||
| - | 5757 | Startk1, Startk2: Integer; |
|
| - | 5758 | StartY: Integer; |
|
| - | 5759 | EndY: Integer; |
|
| - | 5760 | ||
| - | 5761 | DestStartY: Integer; |
|
| - | 5762 | begin |
|
| - | 5763 | if Self.BitCount <> 24 then Exit; |
|
| - | 5764 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5765 | ||
| - | 5766 | Startk1 := 3 * SourceX; |
|
| - | 5767 | Startk2 := 3 * X; |
|
| - | 5768 | ||
| - | 5769 | DestStartY := Y - SourceY; |
|
| - | 5770 | ||
| - | 5771 | StartY := SourceY; |
|
| - | 5772 | EndY := SourceY + Height; |
|
| - | 5773 | ||
| - | 5774 | if (StartY + DestStartY < 0) then |
|
| - | 5775 | StartY := -DestStartY; |
|
| - | 5776 | if (EndY + DestStartY > Self.Height) then |
|
| - | 5777 | EndY := Self.Height - DestStartY; |
|
| - | 5778 | ||
| - | 5779 | if (StartY < 0) then |
|
| - | 5780 | StartY := 0; |
|
| - | 5781 | if (EndY > SrcDIB.Height) then |
|
| - | 5782 | EndY := SrcDIB.Height; |
|
| - | 5783 | ||
| - | 5784 | if Odd(Y) then BitSwitch1 := true else BitSwitch1 := false; |
|
| - | 5785 | if Odd(X) then BitSwitch2 := true else BitSwitch2 := false; |
|
| - | 5786 | ||
| - | 5787 | for j := StartY to EndY - 1 do |
|
| - | 5788 | begin |
|
| - | 5789 | BitSwitch1 := not BitSwitch1; |
|
| - | 5790 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 5791 | p2 := SrcDIB.Scanline[j]; |
|
| - | 5792 | ||
| - | 5793 | k1 := Startk1; |
|
| - | 5794 | k2 := Startk2; |
|
| - | 5795 | ||
| - | 5796 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 5797 | begin |
|
| - | 5798 | BitSwitch2 := not BitSwitch2; |
|
| - | 5799 | ||
| - | 5800 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 5801 | ||
| - | 5802 | case FilterMode of |
|
| - | 5803 | fmNormal, fmMix50: if not (n = Color) and (BitSwitch1 xor BitSwitch2) then |
|
| - | 5804 | begin |
|
| - | 5805 | p1[k2] := p2[k1]; |
|
| - | 5806 | p1[k2 + 1] := p2[k1 + 1]; |
|
| - | 5807 | p1[k2 + 2] := p2[k1 + 2]; |
|
| - | 5808 | end; |
|
| - | 5809 | fmMix25: if not (n = Color) and (BitSwitch1 and BitSwitch2) then |
|
| - | 5810 | begin |
|
| - | 5811 | p1[k2] := p2[k1]; |
|
| - | 5812 | p1[k2 + 1] := p2[k1 + 1]; |
|
| - | 5813 | p1[k2 + 2] := p2[k1 + 2]; |
|
| - | 5814 | end; |
|
| - | 5815 | fmMix75: if not (n = Color) and (BitSwitch1 or BitSwitch2) then |
|
| - | 5816 | begin |
|
| - | 5817 | p1[k2] := p2[k1]; |
|
| - | 5818 | p1[k2 + 1] := p2[k1 + 1]; |
|
| - | 5819 | p1[k2 + 2] := p2[k1 + 2]; |
|
| - | 5820 | end; |
|
| - | 5821 | end; |
|
| - | 5822 | ||
| - | 5823 | k1 := k1 + 3; |
|
| - | 5824 | k2 := k2 + 3; |
|
| - | 5825 | end; |
|
| - | 5826 | end; |
|
| - | 5827 | end; |
|
| - | 5828 | ||
| - | 5829 | procedure TDIB.DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height, Alpha, Frame: |
|
| - | 5830 | Integer); |
|
| - | 5831 | var |
|
| - | 5832 | frameoffset, i, j, Wid: Integer; |
|
| - | 5833 | p1, p2: pByte; |
|
| - | 5834 | begin |
|
| - | 5835 | if Self.BitCount <> 24 then Exit; |
|
| - | 5836 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5837 | ||
| - | 5838 | if (Alpha < 1) or (Alpha > 256) then Exit; |
|
| - | 5839 | Wid := Width shl 1 + Width; |
|
| - | 5840 | frameoffset := Wid * Frame; |
|
| - | 5841 | for i := 1 to Height - 1 do |
|
| - | 5842 | begin |
|
| - | 5843 | if (i + Y) > (Self.Height - 1) then Break; //add 25.5.2004 JB. |
|
| - | 5844 | p1 := Self.Scanline[i + Y]; |
|
| - | 5845 | p2 := SrcDIB.Scanline[i]; |
|
| - | 5846 | inc(p1, X shl 1 + X + 3); |
|
| - | 5847 | inc(p2, frameoffset + 3); |
|
| - | 5848 | for j := 3 to Wid - 4 do |
|
| - | 5849 | begin |
|
| - | 5850 | inc(p1^, (Alpha - p1^) * p2^ shr 8); |
|
| - | 5851 | inc(p1); |
|
| - | 5852 | inc(p2); |
|
| - | 5853 | end; |
|
| - | 5854 | end; |
|
| - | 5855 | end; |
|
| - | 5856 | ||
| - | 5857 | procedure TDIB.DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 5858 | SourceX, SourceY: Integer; const Color: TColor); |
|
| - | 5859 | var |
|
| - | 5860 | i, j: Integer; |
|
| - | 5861 | k1, k2: Integer; |
|
| - | 5862 | n: Integer; |
|
| - | 5863 | p1, p2: PByteArray; |
|
| - | 5864 | ||
| - | 5865 | Startk1, Startk2: Integer; |
|
| - | 5866 | StartY: Integer; |
|
| - | 5867 | EndY: Integer; |
|
| - | 5868 | ||
| - | 5869 | DestStartY: Integer; |
|
| - | 5870 | begin |
|
| - | 5871 | if Self.BitCount <> 24 then Exit; |
|
| - | 5872 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5873 | ||
| - | 5874 | Startk1 := 3 * SourceX; |
|
| - | 5875 | Startk2 := 3 * X; |
|
| - | 5876 | ||
| - | 5877 | DestStartY := Y - SourceY; |
|
| - | 5878 | ||
| - | 5879 | StartY := SourceY; |
|
| - | 5880 | EndY := SourceY + Height; |
|
| - | 5881 | ||
| - | 5882 | if (StartY + DestStartY < 0) then |
|
| - | 5883 | StartY := -DestStartY; |
|
| - | 5884 | if (EndY + DestStartY > Self.Height) then |
|
| - | 5885 | EndY := Self.Height - DestStartY; |
|
| - | 5886 | ||
| - | 5887 | if (StartY < 0) then |
|
| - | 5888 | StartY := 0; |
|
| - | 5889 | if (EndY > SrcDIB.Height) then |
|
| - | 5890 | EndY := SrcDIB.Height; |
|
| - | 5891 | ||
| - | 5892 | for j := StartY to EndY - 1 do |
|
| - | 5893 | begin |
|
| - | 5894 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 5895 | p2 := SrcDIB.Scanline[j]; |
|
| - | 5896 | ||
| - | 5897 | k1 := Startk1; |
|
| - | 5898 | k2 := Startk2; |
|
| - | 5899 | ||
| - | 5900 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 5901 | begin |
|
| - | 5902 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 5903 | ||
| - | 5904 | if not (n = Color) then |
|
| - | 5905 | begin |
|
| - | 5906 | p1[k2] := (p1[k2] + p2[k1]) shr 1; |
|
| - | 5907 | p1[k2 + 1] := (p1[k2 + 1] + p2[k1 + 1]) shr 1; |
|
| - | 5908 | p1[k2 + 2] := (p1[k2 + 2] + p2[k1 + 2]) shr 1; |
|
| - | 5909 | end; |
|
| - | 5910 | ||
| - | 5911 | k1 := k1 + 3; |
|
| - | 5912 | k2 := k2 + 3; |
|
| - | 5913 | end; |
|
| - | 5914 | end; |
|
| - | 5915 | end; |
|
| - | 5916 | ||
| - | 5917 | procedure TDIB.DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 5918 | SourceX, SourceY, Alpha: Integer; const Color: TColor); |
|
| - | 5919 | var |
|
| - | 5920 | i, j: Integer; |
|
| - | 5921 | k1, k2: Integer; |
|
| - | 5922 | n: Integer; |
|
| - | 5923 | p1, p2: PByteArray; |
|
| - | 5924 | ||
| - | 5925 | Startk1, Startk2: Integer; |
|
| - | 5926 | StartY: Integer; |
|
| - | 5927 | EndY: Integer; |
|
| - | 5928 | ||
| - | 5929 | DestStartY: Integer; |
|
| - | 5930 | begin |
|
| - | 5931 | if Self.BitCount <> 24 then Exit; |
|
| - | 5932 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5933 | ||
| - | 5934 | Startk1 := 3 * SourceX; |
|
| - | 5935 | Startk2 := 3 * x; |
|
| - | 5936 | ||
| - | 5937 | DestStartY := Y - SourceY; |
|
| - | 5938 | ||
| - | 5939 | StartY := SourceY; |
|
| - | 5940 | EndY := SourceY + Height; |
|
| - | 5941 | ||
| - | 5942 | if (EndY + DestStartY > Self.Height) then |
|
| - | 5943 | EndY := Self.Height - DestStartY; |
|
| - | 5944 | ||
| - | 5945 | if (EndY > SrcDIB.Height) then |
|
| - | 5946 | EndY := SrcDIB.Height; |
|
| - | 5947 | ||
| - | 5948 | if (StartY < 0) then |
|
| - | 5949 | StartY := 0; |
|
| - | 5950 | ||
| - | 5951 | if (StartY + DestStartY < 0) then |
|
| - | 5952 | StartY := DestStartY; |
|
| - | 5953 | ||
| - | 5954 | for j := StartY to EndY - 1 do |
|
| - | 5955 | begin |
|
| - | 5956 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 5957 | p2 := SrcDIB.Scanline[j]; |
|
| - | 5958 | ||
| - | 5959 | k1 := Startk1; |
|
| - | 5960 | k2 := Startk2; |
|
| - | 5961 | ||
| - | 5962 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 5963 | begin |
|
| - | 5964 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 5965 | ||
| - | 5966 | if not (n = Color) then |
|
| - | 5967 | begin |
|
| - | 5968 | p1[k2] := (p1[k2] * (256 - Alpha) + p2[k1] * Alpha) shr 8; |
|
| - | 5969 | p1[k2 + 1] := (p1[k2 + 1] * (256 - Alpha) + p2[k1 + 1] * Alpha) shr 8; |
|
| - | 5970 | p1[k2 + 2] := (p1[k2 + 2] * (256 - Alpha) + p2[k1 + 2] * Alpha) shr 8; |
|
| - | 5971 | end; |
|
| - | 5972 | ||
| - | 5973 | k1 := k1 + 3; |
|
| - | 5974 | k2 := k2 + 3; |
|
| - | 5975 | end; |
|
| - | 5976 | end; |
|
| - | 5977 | end; |
|
| - | 5978 | ||
| - | 5979 | procedure TDIB.DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, |
|
| - | 5980 | Width, Height, SourceX, SourceY: Integer); |
|
| - | 5981 | var |
|
| - | 5982 | i, j: Integer; |
|
| - | 5983 | k1, k2, k3: Integer; |
|
| - | 5984 | p1, p2, p3: PByteArray; |
|
| - | 5985 | ||
| - | 5986 | Startk1, Startk2: Integer; |
|
| - | 5987 | StartY: Integer; |
|
| - | 5988 | EndY: Integer; |
|
| - | 5989 | ||
| - | 5990 | DestStartY: Integer; |
|
| - | 5991 | begin |
|
| - | 5992 | if Self.BitCount <> 24 then Exit; |
|
| - | 5993 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 5994 | ||
| - | 5995 | Startk1 := 3 * SourceX; |
|
| - | 5996 | Startk2 := 3 * x; |
|
| - | 5997 | ||
| - | 5998 | DestStartY := Y - SourceY; |
|
| - | 5999 | ||
| - | 6000 | StartY := SourceY; |
|
| - | 6001 | EndY := SourceY + Height; |
|
| - | 6002 | ||
| - | 6003 | if (EndY + DestStartY > Self.Height) then |
|
| - | 6004 | EndY := Self.Height - DestStartY; |
|
| - | 6005 | ||
| - | 6006 | if (EndY > SrcDIB.Height) then |
|
| - | 6007 | EndY := SrcDIB.Height; |
|
| - | 6008 | ||
| - | 6009 | if (StartY < 0) then |
|
| - | 6010 | StartY := 0; |
|
| - | 6011 | ||
| - | 6012 | if (StartY + DestStartY < 0) then |
|
| - | 6013 | StartY := DestStartY; |
|
| - | 6014 | ||
| - | 6015 | for j := StartY to EndY - 1 do |
|
| - | 6016 | begin |
|
| - | 6017 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 6018 | p2 := SrcDIB.Scanline[j]; |
|
| - | 6019 | p3 := MaskDIB.Scanline[j]; |
|
| - | 6020 | ||
| - | 6021 | k1 := Startk1; |
|
| - | 6022 | k2 := Startk2; |
|
| - | 6023 | k3 := 0; |
|
| - | 6024 | ||
| - | 6025 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 6026 | begin |
|
| - | 6027 | p1[k2] := (p1[k2] * (256 - p3[k3]) + p2[k1] * p3[k3]) shr 8; |
|
| - | 6028 | p1[k2 + 1] := (p1[k2 + 1] * (256 - p3[k3]) + p2[k1 + 1] * p3[k3]) shr 8; |
|
| - | 6029 | p1[k2 + 2] := (p1[k2 + 2] * (256 - p3[k3]) + p2[k1 + 2] * p3[k3]) shr 8; |
|
| - | 6030 | ||
| - | 6031 | k1 := k1 + 3; |
|
| - | 6032 | k2 := k2 + 3; |
|
| - | 6033 | k3 := k3 + 3; |
|
| - | 6034 | end; |
|
| - | 6035 | end; |
|
| - | 6036 | end; |
|
| - | 6037 | ||
| - | 6038 | procedure TDIB.DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 6039 | SourceX, SourceY: Integer; const Color: TColor); |
|
| - | 6040 | var |
|
| - | 6041 | i, j, r, g, b: Integer; |
|
| - | 6042 | k1, k2: Integer; |
|
| - | 6043 | n: Integer; |
|
| - | 6044 | p1, p2: PByteArray; |
|
| - | 6045 | ||
| - | 6046 | Startk1, Startk2: Integer; |
|
| - | 6047 | StartY: Integer; |
|
| - | 6048 | EndY: Integer; |
|
| - | 6049 | ||
| - | 6050 | DestStartY: Integer; |
|
| - | 6051 | begin |
|
| - | 6052 | if Self.BitCount <> 24 then Exit; |
|
| - | 6053 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 6054 | ||
| - | 6055 | Startk1 := 3 * SourceX; |
|
| - | 6056 | Startk2 := 3 * x; |
|
| - | 6057 | ||
| - | 6058 | DestStartY := Y - SourceY; |
|
| - | 6059 | ||
| - | 6060 | StartY := SourceY; |
|
| - | 6061 | EndY := SourceY + Height; |
|
| - | 6062 | ||
| - | 6063 | if (EndY + DestStartY > Self.Height) then |
|
| - | 6064 | EndY := Self.Height - DestStartY; |
|
| - | 6065 | ||
| - | 6066 | if (EndY > SrcDIB.Height) then |
|
| - | 6067 | EndY := SrcDIB.Height; |
|
| - | 6068 | ||
| - | 6069 | if (StartY < 0) then |
|
| - | 6070 | StartY := 0; |
|
| - | 6071 | ||
| - | 6072 | if (StartY + DestStartY < 0) then |
|
| - | 6073 | StartY := DestStartY; |
|
| - | 6074 | ||
| - | 6075 | r := 0; |
|
| - | 6076 | g := 0; |
|
| - | 6077 | b := 0; |
|
| - | 6078 | ||
| - | 6079 | for j := StartY to EndY - 1 do |
|
| - | 6080 | begin |
|
| - | 6081 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 6082 | p2 := SrcDIB.Scanline[j]; |
|
| - | 6083 | ||
| - | 6084 | k1 := Startk1; |
|
| - | 6085 | k2 := Startk2; |
|
| - | 6086 | ||
| - | 6087 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 6088 | begin |
|
| - | 6089 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 6090 | ||
| - | 6091 | if Random(100) < 50 then |
|
| - | 6092 | begin |
|
| - | 6093 | b := p1[k2]; |
|
| - | 6094 | g := p1[k2 + 1]; |
|
| - | 6095 | r := p1[k2 + 2]; |
|
| - | 6096 | end; |
|
| - | 6097 | ||
| - | 6098 | if not (n = Color) then |
|
| - | 6099 | begin |
|
| - | 6100 | p1[k2] := b; |
|
| - | 6101 | p1[k2 + 1] := g; |
|
| - | 6102 | p1[k2 + 2] := r; |
|
| - | 6103 | end; |
|
| - | 6104 | ||
| - | 6105 | k1 := k1 + 3; |
|
| - | 6106 | k2 := k2 + 3; |
|
| - | 6107 | end; |
|
| - | 6108 | end; |
|
| - | 6109 | end; |
|
| - | 6110 | ||
| - | 6111 | procedure TDIB.DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, |
|
| - | 6112 | SourceX, SourceY: Integer; const TransColor, ForeColor, BackColor: TColor); |
|
| - | 6113 | var |
|
| - | 6114 | i, j, r1, g1, b1, r2, g2, b2: Integer; |
|
| - | 6115 | k1, k2: Integer; |
|
| - | 6116 | n: Integer; |
|
| - | 6117 | p1, p2: PByteArray; |
|
| - | 6118 | Startk1, Startk2, StartY, EndY, DestStartY: Integer; |
|
| - | 6119 | begin |
|
| - | 6120 | if Self.BitCount <> 24 then Exit; |
|
| - | 6121 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 6122 | ||
| - | 6123 | Startk1 := 3 * SourceX; |
|
| - | 6124 | Startk2 := 3 * x; |
|
| - | 6125 | ||
| - | 6126 | DestStartY := Y - SourceY; |
|
| - | 6127 | ||
| - | 6128 | StartY := SourceY; |
|
| - | 6129 | EndY := SourceY + Height; |
|
| - | 6130 | ||
| - | 6131 | if (EndY + DestStartY > Self.Height) then |
|
| - | 6132 | EndY := Self.Height - DestStartY; |
|
| - | 6133 | ||
| - | 6134 | if (EndY > SrcDIB.Height) then |
|
| - | 6135 | EndY := SrcDIB.Height; |
|
| - | 6136 | ||
| - | 6137 | if (StartY < 0) then |
|
| - | 6138 | StartY := 0; |
|
| - | 6139 | ||
| - | 6140 | if (StartY + DestStartY < 0) then |
|
| - | 6141 | StartY := DestStartY; |
|
| - | 6142 | ||
| - | 6143 | r1 := GetRValue(BackColor); |
|
| - | 6144 | g1 := GetGValue(BackColor); |
|
| - | 6145 | b1 := GetBValue(BackColor); |
|
| - | 6146 | ||
| - | 6147 | r2 := GetRValue(ForeColor); |
|
| - | 6148 | g2 := GetGValue(ForeColor); |
|
| - | 6149 | b2 := GetBValue(ForeColor); |
|
| - | 6150 | ||
| - | 6151 | ||
| - | 6152 | for j := StartY to EndY - 1 do |
|
| - | 6153 | begin |
|
| - | 6154 | p1 := Self.Scanline[j + DestStartY]; |
|
| - | 6155 | p2 := SrcDIB.Scanline[j]; |
|
| - | 6156 | ||
| - | 6157 | k1 := Startk1; |
|
| - | 6158 | k2 := Startk2; |
|
| - | 6159 | ||
| - | 6160 | for i := SourceX to SourceX + Width - 1 do |
|
| - | 6161 | begin |
|
| - | 6162 | n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2]; |
|
| - | 6163 | ||
| - | 6164 | if (n = TransColor) then |
|
| - | 6165 | begin |
|
| - | 6166 | p1[k2] := b1; |
|
| - | 6167 | p1[k2 + 1] := g1; |
|
| - | 6168 | p1[k2 + 2] := r1; |
|
| - | 6169 | end |
|
| - | 6170 | else |
|
| - | 6171 | begin |
|
| - | 6172 | p1[k2] := b2; |
|
| - | 6173 | p1[k2 + 1] := g2; |
|
| - | 6174 | p1[k2 + 2] := r2; |
|
| - | 6175 | end; |
|
| - | 6176 | ||
| - | 6177 | k1 := k1 + 3; |
|
| - | 6178 | k2 := k2 + 3; |
|
| - | 6179 | end; |
|
| - | 6180 | end; |
|
| - | 6181 | end; |
|
| - | 6182 | ||
| - | 6183 | procedure TDIB.Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting); |
|
| - | 6184 | var i, j, k: Integer; |
|
| - | 6185 | p1, p2, p3, p4: PByteArray; |
|
| - | 6186 | begin |
|
| - | 6187 | if Self.BitCount <> 24 then Exit; |
|
| - | 6188 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 6189 | ||
| - | 6190 | for i := 1 to SrcDIB.Height - 2 do |
|
| - | 6191 | begin |
|
| - | 6192 | p1 := SrcDIB.ScanLine[i - 1]; |
|
| - | 6193 | p2 := SrcDIB.ScanLine[i]; |
|
| - | 6194 | p3 := SrcDIB.ScanLine[i + 1]; |
|
| - | 6195 | p4 := Self.ScanLine[i]; |
|
| - | 6196 | for j := 3 to 3 * SrcDIB.Width - 4 do |
|
| - | 6197 | begin |
|
| - | 6198 | k := (p1[j - 3] * Setting[0] + p1[j] * Setting[1] + p1[j + 3] * Setting[2] + |
|
| - | 6199 | p2[j - 3] * Setting[3] + p2[j] * Setting[4] + p2[j + 3] * Setting[5] + |
|
| - | 6200 | p3[j - 3] * Setting[6] + p3[j] * Setting[7] + p3[j + 3] * Setting[8]) |
|
| - | 6201 | div Setting[9]; |
|
| - | 6202 | if k < 0 then k := 0; |
|
| - | 6203 | if k > 255 then k := 255; |
|
| - | 6204 | p4[j] := k; |
|
| - | 6205 | end; |
|
| - | 6206 | end; |
|
| - | 6207 | end; |
|
| - | 6208 | ||
| - | 6209 | procedure TDIB.DrawAntialias(SrcDIB: TDIB); |
|
| - | 6210 | var i, j, k, l, m: Integer; |
|
| - | 6211 | p1, p2, p3: PByteArray; |
|
| - | 6212 | begin |
|
| - | 6213 | if Self.BitCount <> 24 then Exit; |
|
| - | 6214 | if SrcDIB.BitCount <> 24 then Exit; |
|
| - | 6215 | ||
| - | 6216 | for i := 1 to Self.Height - 1 do |
|
| - | 6217 | begin |
|
| - | 6218 | k := i shl 1; |
|
| - | 6219 | p1 := SrcDIB.Scanline[k]; |
|
| - | 6220 | p2 := SrcDIB.Scanline[k + 1]; |
|
| - | 6221 | p3 := Self.Scanline[i]; |
|
| - | 6222 | for j := 1 to Self.Width - 1 do |
|
| - | 6223 | begin |
|
| - | 6224 | m := 3 * j; |
|
| - | 6225 | l := m shl 1; |
|
| - | 6226 | p3[m] := (p1[l] + p1[l + 3] + p2[l] + p2[l + 3]) shr 2; |
|
| - | 6227 | p3[m + 1] := (p1[l + 1] + p1[l + 4] + p2[l + 1] + p2[l + 4]) shr 2; |
|
| - | 6228 | p3[m + 2] := (p1[l + 2] + p1[l + 5] + p2[l + 2] + p2[l + 5]) shr 2; |
|
| - | 6229 | end; |
|
| - | 6230 | end; |
|
| - | 6231 | end; |
|
| - | 6232 | ||
| - | 6233 | procedure TDIB.FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor; |
|
| - | 6234 | FilterMode: TFilterMode); |
|
| - | 6235 | var |
|
| - | 6236 | i, j: Integer; |
|
| - | 6237 | t: TColor; |
|
| - | 6238 | r1, g1, b1, r2, g2, b2: Integer; |
|
| - | 6239 | begin |
|
| - | 6240 | j := ROUND(Sqrt(Sqr(ABS(X2 - X1)) + Sqr(ABS(Y2 - Y1)))); |
|
| - | 6241 | if j < 1 then Exit; |
|
| - | 6242 | ||
| - | 6243 | r1 := GetRValue(Color); |
|
| - | 6244 | g1 := GetGValue(Color); |
|
| - | 6245 | b1 := GetBValue(Color); |
|
| - | 6246 | ||
| - | 6247 | for i := 0 to j do |
|
| - | 6248 | begin |
|
| - | 6249 | t := Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)]; |
|
| - | 6250 | r2 := GetRValue(t); |
|
| - | 6251 | g2 := GetGValue(t); |
|
| - | 6252 | b2 := GetBValue(t); |
|
| - | 6253 | case FilterMode of |
|
| - | 6254 | fmNormal: t := RGB(r1 + (((256 - r1) * r2) shr 8), |
|
| - | 6255 | g1 + (((256 - g1) * g2) shr 8), |
|
| - | 6256 | b1 + (((256 - b1) * b2) shr 8)); |
|
| - | 6257 | fmMix25: t := RGB((r1 + r2 * 3) shr 2, (g1 + g2 * 3) shr 2, (b1 + b2 * 3) shr 2); |
|
| - | 6258 | fmMix50: t := RGB((r1 + r2) shr 1, (g1 + g2) shr 1, (b1 + b2) shr 1); |
|
| - | 6259 | fmMix75: t := RGB((r1 * 3 + r2) shr 2, (g1 * 3 + g2) shr 2, (b1 * 3 + b2) shr 2); |
|
| - | 6260 | end; |
|
| - | 6261 | Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)] := t; |
|
| - | 6262 | end; |
|
| - | 6263 | end; |
|
| - | 6264 | ||
| - | 6265 | procedure TDIB.FilterRect(X, Y, Width, Height: Integer; |
|
| - | 6266 | Color: TColor; FilterMode: TFilterMode); |
|
| - | 6267 | var |
|
| - | 6268 | i, j, r, g, b, C1: Integer; |
|
| - | 6269 | p1, p2, p3: pByte; |
|
| - | 6270 | begin |
|
| - | 6271 | if Self.BitCount <> 24 then Exit; |
|
| - | 6272 | ||
| - | 6273 | r := GetRValue(Color); |
|
| - | 6274 | g := GetGValue(Color); |
|
| - | 6275 | b := GetBValue(Color); |
|
| - | 6276 | ||
| - | 6277 | for i := 0 to Height - 1 do |
|
| - | 6278 | begin |
|
| - | 6279 | p1 := Self.Scanline[i + Y]; |
|
| - | 6280 | Inc(p1, (3 * X)); |
|
| - | 6281 | for j := 0 to Width - 1 do |
|
| - | 6282 | begin |
|
| - | 6283 | case FilterMode of |
|
| - | 6284 | fmNormal: |
|
| - | 6285 | begin |
|
| - | 6286 | p2 := p1; |
|
| - | 6287 | Inc(p2); |
|
| - | 6288 | p3 := p2; |
|
| - | 6289 | Inc(p3); |
|
| - | 6290 | C1 := (p1^ + p2^ + p3^) div 3; |
|
| - | 6291 | ||
| - | 6292 | p1^ := (C1 * b) shr 8; |
|
| - | 6293 | Inc(p1); |
|
| - | 6294 | p1^ := (C1 * g) shr 8; |
|
| - | 6295 | Inc(p1); |
|
| - | 6296 | p1^ := (C1 * r) shr 8; |
|
| - | 6297 | Inc(p1); |
|
| - | 6298 | end; |
|
| - | 6299 | fmMix25: |
|
| - | 6300 | begin |
|
| - | 6301 | p1^ := (3 * p1^ + b) shr 2; |
|
| - | 6302 | Inc(p1); |
|
| - | 6303 | p1^ := (3 * p1^ + g) shr 2; |
|
| - | 6304 | Inc(p1); |
|
| - | 6305 | p1^ := (3 * p1^ + r) shr 2; |
|
| - | 6306 | Inc(p1); |
|
| - | 6307 | end; |
|
| - | 6308 | fmMix50: |
|
| - | 6309 | begin |
|
| - | 6310 | p1^ := (p1^ + b) shr 1; |
|
| - | 6311 | Inc(p1); |
|
| - | 6312 | p1^ := (p1^ + g) shr 1; |
|
| - | 6313 | Inc(p1); |
|
| - | 6314 | p1^ := (p1^ + r) shr 1; |
|
| - | 6315 | Inc(p1); |
|
| - | 6316 | end; |
|
| - | 6317 | fmMix75: |
|
| - | 6318 | begin |
|
| - | 6319 | p1^ := (p1^ + 3 * b) shr 2; |
|
| - | 6320 | Inc(p1); |
|
| - | 6321 | p1^ := (p1^ + 3 * g) shr 2; |
|
| - | 6322 | Inc(p1); |
|
| - | 6323 | p1^ := (p1^ + 3 * r) shr 2; |
|
| - | 6324 | Inc(p1); |
|
| - | 6325 | end; |
|
| - | 6326 | end; |
|
| - | 6327 | end; |
|
| - | 6328 | end; |
|
| - | 6329 | end; |
|
| - | 6330 | ||
| - | 6331 | procedure TDIB.InitLight(Count, Detail: Integer); |
|
| - | 6332 | var |
|
| - | 6333 | i, j: Integer; |
|
| - | 6334 | begin |
|
| - | 6335 | LG_COUNT := Count; |
|
| - | 6336 | LG_DETAIL := Detail; |
|
| - | 6337 | ||
| - | 6338 | for i := 0 to 255 do // Build Lightning LUT |
|
| - | 6339 | for j := 0 to 255 do |
|
| - | 6340 | FLUTDist[i, j] := ROUND(Sqrt(Sqr(i * 10) + Sqr(j * 10))); |
|
| - | 6341 | end; |
|
| - | 6342 | ||
| - | 6343 | procedure TDIB.DrawLights(FLight: TLightArray; |
|
| - | 6344 | AmbientLight: TColor); |
|
| - | 6345 | var |
|
| - | 6346 | i, j, l, m, n, o, q, D1, D2, R, G, B, AR, AG, AB: Integer; |
|
| - | 6347 | P: array{$IFNDEF VER4UP} [0..4096]{$ENDIF} of PByteArray; |
|
| - | 6348 | begin |
|
| - | 6349 | if Self.BitCount <> 24 then Exit; |
|
| - | 6350 | ||
| - | 6351 | {$IFDEF VER4UP} |
|
| - | 6352 | SetLength(P, LG_DETAIL); |
|
| - | 6353 | {$ENDIF} |
|
| - | 6354 | AR := GetRValue(AmbientLight); |
|
| - | 6355 | AG := GetGValue(AmbientLight); |
|
| - | 6356 | AB := GetBValue(AmbientLight); |
|
| - | 6357 | ||
| - | 6358 | for i := (Self.Height div (LG_DETAIL + 1)) downto 1 do |
|
| - | 6359 | begin |
|
| - | 6360 | for o := 0 to LG_DETAIL do |
|
| - | 6361 | P[o] := Self.Scanline[(LG_DETAIL + 1) * i - o]; |
|
| - | 6362 | ||
| - | 6363 | for j := (Self.Width div (LG_DETAIL + 1)) downto 1 do |
|
| - | 6364 | begin |
|
| - | 6365 | R := AR; |
|
| - | 6366 | G := AG; |
|
| - | 6367 | B := AB; |
|
| - | 6368 | ||
| - | 6369 | for l := LG_COUNT - 1 downto 0 do // Check the lightsources |
|
| - | 6370 | begin |
|
| - | 6371 | D1 := ABS(j * (LG_DETAIL + 1) - FLight[l].X) div FLight[l].Size1; |
|
| - | 6372 | D2 := ABS(i * (LG_DETAIL + 1) - FLight[l].Y) div FLight[l].Size2; |
|
| - | 6373 | if D1 > 255 then D1 := 255; |
|
| - | 6374 | if D2 > 255 then D2 := 255; |
|
| - | 6375 | ||
| - | 6376 | m := 255 - FLUTDist[D1, D2]; |
|
| - | 6377 | if m < 0 then m := 0; |
|
| - | 6378 | ||
| - | 6379 | Inc(R, (PosValue(GetRValue(FLight[l].Color) - R) * m shr 8)); |
|
| - | 6380 | Inc(G, (PosValue(GetGValue(FLight[l].Color) - G) * m shr 8)); |
|
| - | 6381 | Inc(B, (PosValue(GetBValue(FLight[l].Color) - B) * m shr 8)); |
|
| - | 6382 | end; |
|
| - | 6383 | ||
| - | 6384 | for q := LG_DETAIL downto 0 do |
|
| - | 6385 | begin |
|
| - | 6386 | n := 3 * (j * (LG_DETAIL + 1) - q); |
|
| - | 6387 | ||
| - | 6388 | for o := LG_DETAIL downto 0 do |
|
| - | 6389 | begin |
|
| - | 6390 | P[o][n] := (P[o][n] * B) shr 8; |
|
| - | 6391 | P[o][n + 1] := (P[o][n + 1] * G) shr 8; |
|
| - | 6392 | P[o][n + 2] := (P[o][n + 2] * R) shr 8; |
|
| - | 6393 | end; |
|
| - | 6394 | end; |
|
| - | 6395 | end; |
|
| - | 6396 | end; |
|
| - | 6397 | {$IFDEF VER4UP} |
|
| - | 6398 | SetLength(P, 0); |
|
| - | 6399 | {$ENDIF} |
|
| - | 6400 | end; |
|
| - | 6401 | ||
| - | 6402 | procedure TDIB.DrawOn(Dest: TRect; DestCanvas: TCanvas; Xsrc, Ysrc: Integer); |
|
| - | 6403 | {procedure is supplement of original TDIBUltra function} |
|
| - | 6404 | begin |
|
| - | 6405 | //if not AsSigned(SrcCanvas) then Exit; |
|
| - | 6406 | if (Xsrc < 0) then |
|
| - | 6407 | begin |
|
| - | 6408 | Dec(Dest.Left, Xsrc); |
|
| - | 6409 | Inc(Dest.Right {Width }, Xsrc); |
|
| - | 6410 | Xsrc := 0 |
|
| - | 6411 | end; |
|
| - | 6412 | if (Ysrc < 0) then |
|
| - | 6413 | begin |
|
| - | 6414 | Dec(Dest.Top, Ysrc); |
|
| - | 6415 | Inc(Dest.Bottom {Height}, Ysrc); |
|
| - | 6416 | Ysrc := 0 |
|
| - | 6417 | end; |
|
| - | 6418 | BitBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, Self.Canvas.Handle, Xsrc, Ysrc, SRCCOPY); |
|
| - | 6419 | end; |
|
| - | 6420 | ||
| - | 6421 | { DXFusion <- } |
|
| - | 6422 | ||
| - | 6423 | { added effect for DIB } |
|
| - | 6424 | ||
| - | 6425 | function IntToByte(i: Integer): Byte; |
|
| - | 6426 | begin |
|
| - | 6427 | if i > 255 then Result := 255 |
|
| - | 6428 | else if i < 0 then Result := 0 |
|
| - | 6429 | else Result := i; |
|
| - | 6430 | end; |
|
| - | 6431 | ||
| - | 6432 | {standalone routine} |
|
| - | 6433 | ||
| - | 6434 | procedure TDIB.Darker(Percent: Integer); |
|
| - | 6435 | {color to dark in percent} |
|
| - | 6436 | var |
|
| - | 6437 | p0: pbytearray; |
|
| - | 6438 | r, g, b, x, y: Integer; |
|
| - | 6439 | begin |
|
| - | 6440 | if Self.BitCount <> 24 then Exit; |
|
| - | 6441 | for y := 0 to Self.Height - 1 do |
|
| - | 6442 | begin |
|
| - | 6443 | p0 := Self.ScanLine[y]; |
|
| - | 6444 | for x := 0 to Self.Width - 1 do |
|
| - | 6445 | begin |
|
| - | 6446 | r := p0[x * 3]; |
|
| - | 6447 | g := p0[x * 3 + 1]; |
|
| - | 6448 | b := p0[x * 3 + 2]; |
|
| - | 6449 | p0[x * 3] := Round(R * Percent / 100); |
|
| - | 6450 | p0[x * 3 + 1] := Round(G * Percent / 100); |
|
| - | 6451 | p0[x * 3 + 2] := Round(B * Percent / 100); |
|
| - | 6452 | end; |
|
| - | 6453 | end; |
|
| - | 6454 | end; |
|
| - | 6455 | ||
| - | 6456 | procedure TDIB.Lighter(Percent: Integer); |
|
| - | 6457 | var |
|
| - | 6458 | p0: pbytearray; |
|
| - | 6459 | r, g, b, x, y: Integer; |
|
| - | 6460 | begin |
|
| - | 6461 | if Self.BitCount <> 24 then Exit; |
|
| - | 6462 | for y := 0 to Self.Height - 1 do |
|
| - | 6463 | begin |
|
| - | 6464 | p0 := Self.ScanLine[y]; |
|
| - | 6465 | for x := 0 to Self.Width - 1 do |
|
| - | 6466 | begin |
|
| - | 6467 | r := p0[x * 3]; |
|
| - | 6468 | g := p0[x * 3 + 1]; |
|
| - | 6469 | b := p0[x * 3 + 2]; |
|
| - | 6470 | p0[x * 3] := Round(R * Percent / 100) + Round(255 - Percent / 100 * 255); |
|
| - | 6471 | p0[x * 3 + 1] := Round(G * Percent / 100) + Round(255 - Percent / 100 * 255); |
|
| - | 6472 | p0[x * 3 + 2] := Round(B * Percent / 100) + Round(255 - Percent / 100 * 255); |
|
| - | 6473 | end; |
|
| - | 6474 | end; |
|
| - | 6475 | end; |
|
| - | 6476 | ||
| - | 6477 | procedure TDIB.Darkness(Amount: Integer); |
|
| - | 6478 | var |
|
| - | 6479 | p0: pbytearray; |
|
| - | 6480 | r, g, b, x, y: Integer; |
|
| - | 6481 | begin |
|
| - | 6482 | if Self.BitCount <> 24 then Exit; |
|
| - | 6483 | for y := 0 to Self.Height - 1 do |
|
| - | 6484 | begin |
|
| - | 6485 | p0 := Self.ScanLine[y]; |
|
| - | 6486 | for x := 0 to Self.Width - 1 do |
|
| - | 6487 | begin |
|
| - | 6488 | r := p0[x * 3]; |
|
| - | 6489 | g := p0[x * 3 + 1]; |
|
| - | 6490 | b := p0[x * 3 + 2]; |
|
| - | 6491 | p0[x * 3] := IntToByte(r - ((r) * Amount) div 255); |
|
| - | 6492 | p0[x * 3 + 1] := IntToByte(g - ((g) * Amount) div 255); |
|
| - | 6493 | p0[x * 3 + 2] := IntToByte(b - ((b) * Amount) div 255); |
|
| - | 6494 | end; |
|
| - | 6495 | end; |
|
| - | 6496 | end; |
|
| - | 6497 | ||
| - | 6498 | function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 6499 | begin |
|
| - | 6500 | if i > Max then Result := Max |
|
| - | 6501 | else if i < Min then Result := Min |
|
| - | 6502 | else Result := i; |
|
| - | 6503 | end; |
|
| - | 6504 | ||
| - | 6505 | procedure TDIB.DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended); |
|
| - | 6506 | var |
|
| - | 6507 | Top, Bottom, Left, Right, eww, nsw, fx, fy, wx, wy: Extended; |
|
| - | 6508 | cAngle, sAngle: Double; |
|
| - | 6509 | xDiff, yDiff, ifx, ify, px, py, ix, iy, x, y: Integer; |
|
| - | 6510 | nw, ne, sw, se: TBGR; |
|
| - | 6511 | P1, P2, P3: Pbytearray; |
|
| - | 6512 | begin |
|
| - | 6513 | Angle := angle; |
|
| - | 6514 | Angle := -Angle * Pi / 180; |
|
| - | 6515 | sAngle := Sin(Angle); |
|
| - | 6516 | cAngle := Cos(Angle); |
|
| - | 6517 | xDiff := (Self.Width - Src.Width) div 2; |
|
| - | 6518 | yDiff := (Self.Height - Src.Height) div 2; |
|
| - | 6519 | for y := 0 to Self.Height - 1 do |
|
| - | 6520 | begin |
|
| - | 6521 | P3 := Self.scanline[y]; |
|
| - | 6522 | py := 2 * (y - cy) + 1; |
|
| - | 6523 | for x := 0 to Self.Width - 1 do |
|
| - | 6524 | begin |
|
| - | 6525 | px := 2 * (x - cx) + 1; |
|
| - | 6526 | fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff; |
|
| - | 6527 | fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff; |
|
| - | 6528 | ifx := Round(fx); |
|
| - | 6529 | ify := Round(fy); |
|
| - | 6530 | ||
| - | 6531 | if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then |
|
| - | 6532 | begin |
|
| - | 6533 | eww := fx - ifx; |
|
| - | 6534 | nsw := fy - ify; |
|
| - | 6535 | iy := TrimInt(ify + 1, 0, Src.Height - 1); |
|
| - | 6536 | ix := TrimInt(ifx + 1, 0, Src.Width - 1); |
|
| - | 6537 | P1 := Src.scanline[ify]; |
|
| - | 6538 | P2 := Src.scanline[iy]; |
|
| - | 6539 | nw.r := P1[ifx * 3]; |
|
| - | 6540 | nw.g := P1[ifx * 3 + 1]; |
|
| - | 6541 | nw.b := P1[ifx * 3 + 2]; |
|
| - | 6542 | ne.r := P1[ix * 3]; |
|
| - | 6543 | ne.g := P1[ix * 3 + 1]; |
|
| - | 6544 | ne.b := P1[ix * 3 + 2]; |
|
| - | 6545 | sw.r := P2[ifx * 3]; |
|
| - | 6546 | sw.g := P2[ifx * 3 + 1]; |
|
| - | 6547 | sw.b := P2[ifx * 3 + 2]; |
|
| - | 6548 | se.r := P2[ix * 3]; |
|
| - | 6549 | se.g := P2[ix * 3 + 1]; |
|
| - | 6550 | se.b := P2[ix * 3 + 2]; |
|
| - | 6551 | ||
| - | 6552 | Top := nw.b + eww * (ne.b - nw.b); |
|
| - | 6553 | Bottom := sw.b + eww * (se.b - sw.b); |
|
| - | 6554 | P3[x * 3 + 2] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
|
| - | 6555 | ||
| - | 6556 | Top := nw.g + eww * (ne.g - nw.g); |
|
| - | 6557 | Bottom := sw.g + eww * (se.g - sw.g); |
|
| - | 6558 | P3[x * 3 + 1] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
|
| - | 6559 | ||
| - | 6560 | Top := nw.r + eww * (ne.r - nw.r); |
|
| - | 6561 | Bottom := sw.r + eww * (se.r - sw.r); |
|
| - | 6562 | P3[x * 3] := IntToByte(Round(Top + nsw * (Bottom - Top))); |
|
| - | 6563 | end; |
|
| - | 6564 | end; |
|
| - | 6565 | end; |
|
| - | 6566 | end; |
|
| - | 6567 | ||
| - | 6568 | //---------------------- |
|
| - | 6569 | //--- 24 bit count routines ---------------------- |
|
| - | 6570 | //---------------------- |
|
| - | 6571 | ||
| - | 6572 | procedure TDIB.DoInvert; |
|
| - | 6573 | procedure PicInvert(src: TDIB); |
|
| - | 6574 | var w, h, x, y: Integer; |
|
| - | 6575 | p: pbytearray; |
|
| - | 6576 | begin |
|
| - | 6577 | w := src.width; |
|
| - | 6578 | h := src.height; |
|
| - | 6579 | src.BitCount := 24; |
|
| - | 6580 | for y := 0 to h - 1 do |
|
| - | 6581 | begin |
|
| - | 6582 | p := src.scanline[y]; |
|
| - | 6583 | for x := 0 to w - 1 do |
|
| - | 6584 | begin |
|
| - | 6585 | p[x * 3] := not p[x * 3]; |
|
| - | 6586 | p[x * 3 + 1] := not p[x * 3 + 1]; |
|
| - | 6587 | p[x * 3 + 2] := not p[x * 3 + 2]; |
|
| - | 6588 | end; |
|
| - | 6589 | end; |
|
| - | 6590 | end; |
|
| - | 6591 | begin |
|
| - | 6592 | PicInvert(Self); |
|
| - | 6593 | end; |
|
| - | 6594 | ||
| - | 6595 | procedure TDIB.DoAddColorNoise(Amount: Integer); |
|
| - | 6596 | procedure AddColorNoise(var clip: TDIB; Amount: Integer); |
|
| - | 6597 | var |
|
| - | 6598 | p0: pbytearray; |
|
| - | 6599 | x, y, r, g, b: Integer; |
|
| - | 6600 | begin |
|
| - | 6601 | for y := 0 to clip.Height - 1 do |
|
| - | 6602 | begin |
|
| - | 6603 | p0 := clip.ScanLine[y]; |
|
| - | 6604 | for x := 0 to clip.Width - 1 do |
|
| - | 6605 | begin |
|
| - | 6606 | r := p0[x * 3] + (Random(Amount) - (Amount shr 1)); |
|
| - | 6607 | g := p0[x * 3 + 1] + (Random(Amount) - (Amount shr 1)); |
|
| - | 6608 | b := p0[x * 3 + 2] + (Random(Amount) - (Amount shr 1)); |
|
| - | 6609 | p0[x * 3] := IntToByte(r); |
|
| - | 6610 | p0[x * 3 + 1] := IntToByte(g); |
|
| - | 6611 | p0[x * 3 + 2] := IntToByte(b); |
|
| - | 6612 | end; |
|
| - | 6613 | end; |
|
| - | 6614 | end; |
|
| - | 6615 | var BB: TDIB; |
|
| - | 6616 | begin |
|
| - | 6617 | BB := TDIB.Create; |
|
| - | 6618 | BB.BitCount := 24; |
|
| - | 6619 | BB.Assign(Self); |
|
| - | 6620 | AddColorNoise(bb, Amount); |
|
| - | 6621 | Self.Assign(BB); |
|
| - | 6622 | BB.Free; |
|
| - | 6623 | end; |
|
| - | 6624 | ||
| - | 6625 | procedure TDIB.DoAddMonoNoise(Amount: Integer); |
|
| - | 6626 | procedure _AddMonoNoise(var clip: TDIB; Amount: Integer); |
|
| - | 6627 | var |
|
| - | 6628 | p0: pbytearray; |
|
| - | 6629 | x, y, a, r, g, b: Integer; |
|
| - | 6630 | begin |
|
| - | 6631 | for y := 0 to clip.Height - 1 do |
|
| - | 6632 | begin |
|
| - | 6633 | p0 := clip.scanline[y]; |
|
| - | 6634 | for x := 0 to clip.Width - 1 do |
|
| - | 6635 | begin |
|
| - | 6636 | a := Random(Amount) - (Amount shr 1); |
|
| - | 6637 | r := p0[x * 3] + a; |
|
| - | 6638 | g := p0[x * 3 + 1] + a; |
|
| - | 6639 | b := p0[x * 3 + 2] + a; |
|
| - | 6640 | p0[x * 3] := IntToByte(r); |
|
| - | 6641 | p0[x * 3 + 1] := IntToByte(g); |
|
| - | 6642 | p0[x * 3 + 2] := IntToByte(b); |
|
| - | 6643 | end; |
|
| - | 6644 | end; |
|
| - | 6645 | end; |
|
| - | 6646 | var BB: TDIB; |
|
| - | 6647 | begin |
|
| - | 6648 | BB := TDIB.Create; |
|
| - | 6649 | BB.BitCount := 24; |
|
| - | 6650 | BB.Assign(Self); |
|
| - | 6651 | _AddMonoNoise(bb, Amount); |
|
| - | 6652 | Self.Assign(BB); |
|
| - | 6653 | BB.Free; |
|
| - | 6654 | end; |
|
| - | 6655 | ||
| - | 6656 | procedure TDIB.DoAntiAlias; |
|
| - | 6657 | procedure AntiAlias(clip: TDIB); |
|
| - | 6658 | procedure AntiAliasRect(clip: TDIB; XOrigin, YOrigin, XFinal, YFinal: Integer); |
|
| - | 6659 | var Memo, x, y: Integer; (* Composantes primaires des points environnants *) |
|
| - | 6660 | p0, p1, p2: pbytearray; |
|
| - | 6661 | begin |
|
| - | 6662 | if XFinal < XOrigin then begin Memo := XOrigin; XOrigin := XFinal; XFinal := Memo; end; (* Inversion des valeurs *) |
|
| - | 6663 | if YFinal < YOrigin then begin Memo := YOrigin; YOrigin := YFinal; YFinal := Memo; end; (* si diffrence ngative*) |
|
| - | 6664 | XOrigin := max(1, XOrigin); |
|
| - | 6665 | YOrigin := max(1, YOrigin); |
|
| - | 6666 | XFinal := min(clip.width - 2, XFinal); |
|
| - | 6667 | YFinal := min(clip.height - 2, YFinal); |
|
| - | 6668 | clip.BitCount := 24; |
|
| - | 6669 | for y := YOrigin to YFinal do |
|
| - | 6670 | begin |
|
| - | 6671 | p0 := clip.ScanLine[y - 1]; |
|
| - | 6672 | p1 := clip.scanline[y]; |
|
| - | 6673 | p2 := clip.ScanLine[y + 1]; |
|
| - | 6674 | for x := XOrigin to XFinal do |
|
| - | 6675 | begin |
|
| - | 6676 | p1[x * 3] := (p0[x * 3] + p2[x * 3] + p1[(x - 1) * 3] + p1[(x + 1) * 3]) div 4; |
|
| - | 6677 | p1[x * 3 + 1] := (p0[x * 3 + 1] + p2[x * 3 + 1] + p1[(x - 1) * 3 + 1] + p1[(x + 1) * 3 + 1]) div 4; |
|
| - | 6678 | p1[x * 3 + 2] := (p0[x * 3 + 2] + p2[x * 3 + 2] + p1[(x - 1) * 3 + 2] + p1[(x + 1) * 3 + 2]) div 4; |
|
| - | 6679 | end; |
|
| - | 6680 | end; |
|
| - | 6681 | end; |
|
| - | 6682 | begin |
|
| - | 6683 | AntiAliasRect(clip, 0, 0, clip.width, clip.height); |
|
| - | 6684 | end; |
|
| - | 6685 | begin |
|
| - | 6686 | AntiAlias(Self); |
|
| - | 6687 | end; |
|
| - | 6688 | ||
| - | 6689 | procedure TDIB.DoContrast(Amount: Integer); |
|
| - | 6690 | procedure _Contrast(var clip: TDIB; Amount: Integer); |
|
| - | 6691 | var |
|
| - | 6692 | p0: pbytearray; |
|
| - | 6693 | rg, gg, bg, r, g, b, x, y: Integer; |
|
| - | 6694 | begin |
|
| - | 6695 | for y := 0 to clip.Height - 1 do |
|
| - | 6696 | begin |
|
| - | 6697 | p0 := clip.scanline[y]; |
|
| - | 6698 | for x := 0 to clip.Width - 1 do |
|
| - | 6699 | begin |
|
| - | 6700 | r := p0[x * 3]; |
|
| - | 6701 | g := p0[x * 3 + 1]; |
|
| - | 6702 | b := p0[x * 3 + 2]; |
|
| - | 6703 | rg := (Abs(127 - r) * Amount) div 255; |
|
| - | 6704 | gg := (Abs(127 - g) * Amount) div 255; |
|
| - | 6705 | bg := (Abs(127 - b) * Amount) div 255; |
|
| - | 6706 | if r > 127 then r := r + rg else r := r - rg; |
|
| - | 6707 | if g > 127 then g := g + gg else g := g - gg; |
|
| - | 6708 | if b > 127 then b := b + bg else b := b - bg; |
|
| - | 6709 | p0[x * 3] := IntToByte(r); |
|
| - | 6710 | p0[x * 3 + 1] := IntToByte(g); |
|
| - | 6711 | p0[x * 3 + 2] := IntToByte(b); |
|
| - | 6712 | end; |
|
| - | 6713 | end; |
|
| - | 6714 | end; |
|
| - | 6715 | var BB: TDIB; |
|
| - | 6716 | begin |
|
| - | 6717 | BB := TDIB.Create; |
|
| - | 6718 | BB.BitCount := 24; |
|
| - | 6719 | BB.Assign(Self); |
|
| - | 6720 | _Contrast(bb, Amount); |
|
| - | 6721 | Self.Assign(BB); |
|
| - | 6722 | BB.Free; |
|
| - | 6723 | end; |
|
| - | 6724 | ||
| - | 6725 | procedure TDIB.DoFishEye(Amount: Integer); |
|
| - | 6726 | procedure _FishEye(var Bmp, Dst: TDIB; Amount: Extended); |
|
| - | 6727 | var |
|
| - | 6728 | xmid, ymid: Single; |
|
| - | 6729 | fx, fy: Single; |
|
| - | 6730 | r1, r2: Single; |
|
| - | 6731 | ifx, ify: Integer; |
|
| - | 6732 | dx, dy: Single; |
|
| - | 6733 | rmax: Single; |
|
| - | 6734 | ty, tx: Integer; |
|
| - | 6735 | weight_x, weight_y: array[0..1] of Single; |
|
| - | 6736 | weight: Single; |
|
| - | 6737 | new_red, new_green: Integer; |
|
| - | 6738 | new_blue: Integer; |
|
| - | 6739 | total_red, total_green: Single; |
|
| - | 6740 | total_blue: Single; |
|
| - | 6741 | ix, iy: Integer; |
|
| - | 6742 | sli, slo: PByteArray; |
|
| - | 6743 | begin |
|
| - | 6744 | xmid := Bmp.Width / 2; |
|
| - | 6745 | ymid := Bmp.Height / 2; |
|
| - | 6746 | rmax := Dst.Width * Amount; |
|
| - | 6747 | ||
| - | 6748 | for ty := 0 to Dst.Height - 1 do |
|
| - | 6749 | begin |
|
| - | 6750 | for tx := 0 to Dst.Width - 1 do |
|
| - | 6751 | begin |
|
| - | 6752 | dx := tx - xmid; |
|
| - | 6753 | dy := ty - ymid; |
|
| - | 6754 | r1 := Sqrt(dx * dx + dy * dy); |
|
| - | 6755 | if r1 = 0 then |
|
| - | 6756 | begin |
|
| - | 6757 | fx := xmid; |
|
| - | 6758 | fy := ymid; |
|
| - | 6759 | end |
|
| - | 6760 | else |
|
| - | 6761 | begin |
|
| - | 6762 | r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1); |
|
| - | 6763 | fx := dx * r2 / r1 + xmid; |
|
| - | 6764 | fy := dy * r2 / r1 + ymid; |
|
| - | 6765 | end; |
|
| - | 6766 | ify := Trunc(fy); |
|
| - | 6767 | ifx := Trunc(fx); |
|
| - | 6768 | // Calculate the weights. |
|
| - | 6769 | if fy >= 0 then |
|
| - | 6770 | begin |
|
| - | 6771 | weight_y[1] := fy - ify; |
|
| - | 6772 | weight_y[0] := 1 - weight_y[1]; |
|
| - | 6773 | end |
|
| - | 6774 | else |
|
| - | 6775 | begin |
|
| - | 6776 | weight_y[0] := -(fy - ify); |
|
| - | 6777 | weight_y[1] := 1 - weight_y[0]; |
|
| - | 6778 | end; |
|
| - | 6779 | if fx >= 0 then |
|
| - | 6780 | begin |
|
| - | 6781 | weight_x[1] := fx - ifx; |
|
| - | 6782 | weight_x[0] := 1 - weight_x[1]; |
|
| - | 6783 | end |
|
| - | 6784 | else |
|
| - | 6785 | begin |
|
| - | 6786 | weight_x[0] := -(fx - ifx); |
|
| - | 6787 | Weight_x[1] := 1 - weight_x[0]; |
|
| - | 6788 | end; |
|
| - | 6789 | ||
| - | 6790 | if ifx < 0 then |
|
| - | 6791 | ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width) |
|
| - | 6792 | else if ifx > Bmp.Width - 1 then |
|
| - | 6793 | ifx := ifx mod Bmp.Width; |
|
| - | 6794 | if ify < 0 then |
|
| - | 6795 | ify := Bmp.Height - 1 - (-ify mod Bmp.Height) |
|
| - | 6796 | else if ify > Bmp.Height - 1 then |
|
| - | 6797 | ify := ify mod Bmp.Height; |
|
| - | 6798 | ||
| - | 6799 | total_red := 0.0; |
|
| - | 6800 | total_green := 0.0; |
|
| - | 6801 | total_blue := 0.0; |
|
| - | 6802 | for ix := 0 to 1 do |
|
| - | 6803 | begin |
|
| - | 6804 | for iy := 0 to 1 do |
|
| - | 6805 | begin |
|
| - | 6806 | if ify + iy < Bmp.Height then |
|
| - | 6807 | sli := Bmp.scanline[ify + iy] |
|
| - | 6808 | else |
|
| - | 6809 | sli := Bmp.scanline[Bmp.Height - ify - iy]; |
|
| - | 6810 | if ifx + ix < Bmp.Width then |
|
| - | 6811 | begin |
|
| - | 6812 | new_red := sli[(ifx + ix) * 3]; |
|
| - | 6813 | new_green := sli[(ifx + ix) * 3 + 1]; |
|
| - | 6814 | new_blue := sli[(ifx + ix) * 3 + 2]; |
|
| - | 6815 | end |
|
| - | 6816 | else |
|
| - | 6817 | begin |
|
| - | 6818 | new_red := sli[(Bmp.Width - ifx - ix) * 3]; |
|
| - | 6819 | new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1]; |
|
| - | 6820 | new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2]; |
|
| - | 6821 | end; |
|
| - | 6822 | weight := weight_x[ix] * weight_y[iy]; |
|
| - | 6823 | total_red := total_red + new_red * weight; |
|
| - | 6824 | total_green := total_green + new_green * weight; |
|
| - | 6825 | total_blue := total_blue + new_blue * weight; |
|
| - | 6826 | end; |
|
| - | 6827 | end; |
|
| - | 6828 | slo := Dst.scanline[ty]; |
|
| - | 6829 | slo[tx * 3] := Round(total_red); |
|
| - | 6830 | slo[tx * 3 + 1] := Round(total_green); |
|
| - | 6831 | slo[tx * 3 + 2] := Round(total_blue); |
|
| - | 6832 | ||
| - | 6833 | end; |
|
| - | 6834 | end; |
|
| - | 6835 | end; |
|
| - | 6836 | var BB1, BB2: TDIB; |
|
| - | 6837 | begin |
|
| - | 6838 | BB1 := TDIB.Create; |
|
| - | 6839 | BB1.BitCount := 24; |
|
| - | 6840 | BB1.Assign(Self); |
|
| - | 6841 | BB2 := TDIB.Create; |
|
| - | 6842 | BB2.BitCount := 24; |
|
| - | 6843 | BB2.Assign(BB1); |
|
| - | 6844 | _FishEye(BB1, BB2, Amount); |
|
| - | 6845 | Self.Assign(BB2); |
|
| - | 6846 | BB1.Free; |
|
| - | 6847 | BB2.Free; |
|
| - | 6848 | end; |
|
| - | 6849 | ||
| - | 6850 | procedure TDIB.DoGrayScale; |
|
| - | 6851 | procedure GrayScale(var clip: TDIB); |
|
| - | 6852 | var |
|
| - | 6853 | p0: pbytearray; |
|
| - | 6854 | Gray, x, y: Integer; |
|
| - | 6855 | begin |
|
| - | 6856 | for y := 0 to clip.Height - 1 do |
|
| - | 6857 | begin |
|
| - | 6858 | p0 := clip.scanline[y]; |
|
| - | 6859 | for x := 0 to clip.Width - 1 do |
|
| - | 6860 | begin |
|
| - | 6861 | Gray := Round(p0[x * 3] * 0.3 + p0[x * 3 + 1] * 0.59 + p0[x * 3 + 2] * 0.11); |
|
| - | 6862 | p0[x * 3] := Gray; |
|
| - | 6863 | p0[x * 3 + 1] := Gray; |
|
| - | 6864 | p0[x * 3 + 2] := Gray; |
|
| - | 6865 | end; |
|
| - | 6866 | end; |
|
| - | 6867 | end; |
|
| - | 6868 | var BB: TDIB; |
|
| - | 6869 | begin |
|
| - | 6870 | BB := TDIB.Create; |
|
| - | 6871 | BB.BitCount := 24; |
|
| - | 6872 | BB.Assign(Self); |
|
| - | 6873 | GrayScale(BB); |
|
| - | 6874 | Self.Assign(BB); |
|
| - | 6875 | BB.Free; |
|
| - | 6876 | end; |
|
| - | 6877 | ||
| - | 6878 | procedure TDIB.DoLightness(Amount: Integer); |
|
| - | 6879 | procedure _Lightness(var clip: TDIB; Amount: Integer); |
|
| - | 6880 | var |
|
| - | 6881 | p0: pbytearray; |
|
| - | 6882 | r, g, b, x, y: Integer; |
|
| - | 6883 | begin |
|
| - | 6884 | for y := 0 to clip.Height - 1 do |
|
| - | 6885 | begin |
|
| - | 6886 | p0 := clip.scanline[y]; |
|
| - | 6887 | for x := 0 to clip.Width - 1 do |
|
| - | 6888 | begin |
|
| - | 6889 | r := p0[x * 3]; |
|
| - | 6890 | g := p0[x * 3 + 1]; |
|
| - | 6891 | b := p0[x * 3 + 2]; |
|
| - | 6892 | p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255); |
|
| - | 6893 | p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255); |
|
| - | 6894 | p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount) div 255); |
|
| - | 6895 | end; |
|
| - | 6896 | end; |
|
| - | 6897 | end; |
|
| - | 6898 | var BB: TDIB; |
|
| - | 6899 | begin |
|
| - | 6900 | BB := TDIB.Create; |
|
| - | 6901 | BB.BitCount := 24; |
|
| - | 6902 | BB.Assign(Self); |
|
| - | 6903 | _Lightness(BB, Amount); |
|
| - | 6904 | Self.Assign(BB); |
|
| - | 6905 | BB.Free; |
|
| - | 6906 | end; |
|
| - | 6907 | ||
| - | 6908 | procedure TDIB.DoDarkness(Amount: Integer); |
|
| - | 6909 | var BB: TDIB; |
|
| - | 6910 | begin |
|
| - | 6911 | BB := TDIB.Create; |
|
| - | 6912 | BB.BitCount := 24; |
|
| - | 6913 | BB.Assign(Self); |
|
| - | 6914 | BB.Darkness(Amount); |
|
| - | 6915 | Self.Assign(BB); |
|
| - | 6916 | BB.Free; |
|
| - | 6917 | end; |
|
| - | 6918 | ||
| - | 6919 | procedure TDIB.DoSaturation(Amount: Integer); |
|
| - | 6920 | procedure _Saturation(var clip: TDIB; Amount: Integer); |
|
| - | 6921 | var |
|
| - | 6922 | p0: pbytearray; |
|
| - | 6923 | Gray, r, g, b, x, y: Integer; |
|
| - | 6924 | begin |
|
| - | 6925 | for y := 0 to clip.Height - 1 do |
|
| - | 6926 | begin |
|
| - | 6927 | p0 := clip.scanline[y]; |
|
| - | 6928 | for x := 0 to clip.Width - 1 do |
|
| - | 6929 | begin |
|
| - | 6930 | r := p0[x * 3]; |
|
| - | 6931 | g := p0[x * 3 + 1]; |
|
| - | 6932 | b := p0[x * 3 + 2]; |
|
| - | 6933 | Gray := (r + g + b) div 3; |
|
| - | 6934 | p0[x * 3] := IntToByte(Gray + (((r - Gray) * Amount) div 255)); |
|
| - | 6935 | p0[x * 3 + 1] := IntToByte(Gray + (((g - Gray) * Amount) div 255)); |
|
| - | 6936 | p0[x * 3 + 2] := IntToByte(Gray + (((b - Gray) * Amount) div 255)); |
|
| - | 6937 | end; |
|
| - | 6938 | end; |
|
| - | 6939 | end; |
|
| - | 6940 | var BB: TDIB; |
|
| - | 6941 | begin |
|
| - | 6942 | BB := TDIB.Create; |
|
| - | 6943 | BB.BitCount := 24; |
|
| - | 6944 | BB.Assign(Self); |
|
| - | 6945 | _Saturation(BB, Amount); |
|
| - | 6946 | Self.Assign(BB); |
|
| - | 6947 | BB.Free; |
|
| - | 6948 | end; |
|
| - | 6949 | ||
| - | 6950 | procedure TDIB.DoSplitBlur(Amount: Integer); |
|
| - | 6951 | {NOTE: For a gaussian blur is amount 3} |
|
| - | 6952 | procedure _SplitBlur(var clip: TDIB; Amount: Integer); |
|
| - | 6953 | var |
|
| - | 6954 | p0, p1, p2: pbytearray; |
|
| - | 6955 | cx, x, y: Integer; |
|
| - | 6956 | Buf: array[0..3, 0..2] of byte; |
|
| - | 6957 | begin |
|
| - | 6958 | if Amount = 0 then Exit; |
|
| - | 6959 | for y := 0 to clip.Height - 1 do |
|
| - | 6960 | begin |
|
| - | 6961 | p0 := clip.scanline[y]; |
|
| - | 6962 | if y - Amount < 0 then p1 := clip.scanline[y] |
|
| - | 6963 | else {y-Amount>0} p1 := clip.ScanLine[y - Amount]; |
|
| - | 6964 | if y + Amount < clip.Height then p2 := clip.ScanLine[y + Amount] |
|
| - | 6965 | else {y+Amount>=Height} p2 := clip.ScanLine[clip.Height - y]; |
|
| - | 6966 | ||
| - | 6967 | for x := 0 to clip.Width - 1 do |
|
| - | 6968 | begin |
|
| - | 6969 | if x - Amount < 0 then cx := x |
|
| - | 6970 | else {x-Amount>0} cx := x - Amount; |
|
| - | 6971 | Buf[0, 0] := p1[cx * 3]; |
|
| - | 6972 | Buf[0, 1] := p1[cx * 3 + 1]; |
|
| - | 6973 | Buf[0, 2] := p1[cx * 3 + 2]; |
|
| - | 6974 | Buf[1, 0] := p2[cx * 3]; |
|
| - | 6975 | Buf[1, 1] := p2[cx * 3 + 1]; |
|
| - | 6976 | Buf[1, 2] := p2[cx * 3 + 2]; |
|
| - | 6977 | if x + Amount < clip.Width then cx := x + Amount |
|
| - | 6978 | else {x+Amount>=Width} cx := clip.Width - x; |
|
| - | 6979 | Buf[2, 0] := p1[cx * 3]; |
|
| - | 6980 | Buf[2, 1] := p1[cx * 3 + 1]; |
|
| - | 6981 | Buf[2, 2] := p1[cx * 3 + 2]; |
|
| - | 6982 | Buf[3, 0] := p2[cx * 3]; |
|
| - | 6983 | Buf[3, 1] := p2[cx * 3 + 1]; |
|
| - | 6984 | Buf[3, 2] := p2[cx * 3 + 2]; |
|
| - | 6985 | p0[x * 3] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2; |
|
| - | 6986 | p0[x * 3 + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2; |
|
| - | 6987 | p0[x * 3 + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2; |
|
| - | 6988 | end; |
|
| - | 6989 | end; |
|
| - | 6990 | end; |
|
| - | 6991 | var BB: TDIB; |
|
| - | 6992 | begin |
|
| - | 6993 | BB := TDIB.Create; |
|
| - | 6994 | BB.BitCount := 24; |
|
| - | 6995 | BB.Assign(Self); |
|
| - | 6996 | _SplitBlur(BB, Amount); |
|
| - | 6997 | Self.Assign(BB); |
|
| - | 6998 | BB.Free; |
|
| - | 6999 | end; |
|
| - | 7000 | ||
| - | 7001 | procedure TDIB.DoGaussianBlur(Amount: Integer); |
|
| - | 7002 | var BB: TDIB; |
|
| - | 7003 | begin |
|
| - | 7004 | BB := TDIB.Create; |
|
| - | 7005 | BB.BitCount := 24; |
|
| - | 7006 | BB.BitCount := 24; |
|
| - | 7007 | BB.Assign(Self); |
|
| - | 7008 | GaussianBlur(BB, Amount); |
|
| - | 7009 | Self.Assign(BB); |
|
| - | 7010 | BB.Free; |
|
| - | 7011 | end; |
|
| - | 7012 | ||
| - | 7013 | procedure TDIB.DoMosaic(Size: Integer); |
|
| - | 7014 | procedure Mosaic(var Bm: TDIB; size: Integer); |
|
| - | 7015 | var |
|
| - | 7016 | x, y, i, j: Integer; |
|
| - | 7017 | p1, p2: pbytearray; |
|
| - | 7018 | r, g, b: byte; |
|
| - | 7019 | begin |
|
| - | 7020 | y := 0; |
|
| - | 7021 | repeat |
|
| - | 7022 | p1 := bm.scanline[y]; |
|
| - | 7023 | repeat |
|
| - | 7024 | j := 1; |
|
| - | 7025 | repeat |
|
| - | 7026 | p2 := bm.scanline[y]; |
|
| - | 7027 | x := 0; |
|
| - | 7028 | repeat |
|
| - | 7029 | r := p1[x * 3]; |
|
| - | 7030 | g := p1[x * 3 + 1]; |
|
| - | 7031 | b := p1[x * 3 + 2]; |
|
| - | 7032 | i := 1; |
|
| - | 7033 | repeat |
|
| - | 7034 | p2[x * 3] := r; |
|
| - | 7035 | p2[x * 3 + 1] := g; |
|
| - | 7036 | p2[x * 3 + 2] := b; |
|
| - | 7037 | inc(x); |
|
| - | 7038 | inc(i); |
|
| - | 7039 | until (x >= bm.width) or (i > size); |
|
| - | 7040 | until x >= bm.width; |
|
| - | 7041 | inc(j); |
|
| - | 7042 | inc(y); |
|
| - | 7043 | until (y >= bm.height) or (j > size); |
|
| - | 7044 | until (y >= bm.height) or (x >= bm.width); |
|
| - | 7045 | until y >= bm.height; |
|
| - | 7046 | end; |
|
| - | 7047 | var BB: TDIB; |
|
| - | 7048 | begin |
|
| - | 7049 | BB := TDIB.Create; |
|
| - | 7050 | BB.BitCount := 24; |
|
| - | 7051 | BB.Assign(Self); |
|
| - | 7052 | Mosaic(BB, Size); |
|
| - | 7053 | Self.Assign(BB); |
|
| - | 7054 | BB.Free; |
|
| - | 7055 | end; |
|
| - | 7056 | ||
| - | 7057 | procedure TDIB.DoTwist(Amount: Integer); |
|
| - | 7058 | procedure _Twist(var Bmp, Dst: TDIB; Amount: Integer); |
|
| - | 7059 | var |
|
| - | 7060 | fxmid, fymid: Single; |
|
| - | 7061 | txmid, tymid: Single; |
|
| - | 7062 | fx, fy: Single; |
|
| - | 7063 | tx2, ty2: Single; |
|
| - | 7064 | r: Single; |
|
| - | 7065 | theta: Single; |
|
| - | 7066 | ifx, ify: Integer; |
|
| - | 7067 | dx, dy: Single; |
|
| - | 7068 | OFFSET: Single; |
|
| - | 7069 | ty, tx: Integer; |
|
| - | 7070 | weight_x, weight_y: array[0..1] of Single; |
|
| - | 7071 | weight: Single; |
|
| - | 7072 | new_red, new_green: Integer; |
|
| - | 7073 | new_blue: Integer; |
|
| - | 7074 | total_red, total_green: Single; |
|
| - | 7075 | total_blue: Single; |
|
| - | 7076 | ix, iy: Integer; |
|
| - | 7077 | sli, slo: PBytearray; |
|
| - | 7078 | ||
| - | 7079 | function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 7080 | begin |
|
| - | 7081 | if xt = 0 then |
|
| - | 7082 | if yt > 0 then |
|
| - | 7083 | Result := Pi / 2 |
|
| - | 7084 | else |
|
| - | 7085 | Result := -(Pi / 2) |
|
| - | 7086 | else |
|
| - | 7087 | begin |
|
| - | 7088 | Result := ArcTan(yt / xt); |
|
| - | 7089 | if xt < 0 then |
|
| - | 7090 | Result := Pi + ArcTan(yt / xt); |
|
| - | 7091 | end; |
|
| - | 7092 | end; |
|
| - | 7093 | ||
| - | 7094 | begin |
|
| - | 7095 | OFFSET := -(Pi / 2); |
|
| - | 7096 | dx := Bmp.Width - 1; |
|
| - | 7097 | dy := Bmp.Height - 1; |
|
| - | 7098 | r := Sqrt(dx * dx + dy * dy); |
|
| - | 7099 | tx2 := r; |
|
| - | 7100 | ty2 := r; |
|
| - | 7101 | txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation |
|
| - | 7102 | tymid := (Bmp.Height - 1) / 2; //Adjust these to move ...... |
|
| - | 7103 | fxmid := (Bmp.Width - 1) / 2; |
|
| - | 7104 | fymid := (Bmp.Height - 1) / 2; |
|
| - | 7105 | if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1; |
|
| - | 7106 | if ty2 >= Bmp.Height then ty2 := Bmp.Height - 1; |
|
| - | 7107 | ||
| - | 7108 | for ty := 0 to Round(ty2) do |
|
| - | 7109 | begin |
|
| - | 7110 | for tx := 0 to Round(tx2) do |
|
| - | 7111 | begin |
|
| - | 7112 | dx := tx - txmid; |
|
| - | 7113 | dy := ty - tymid; |
|
| - | 7114 | r := Sqrt(dx * dx + dy * dy); |
|
| - | 7115 | if r = 0 then |
|
| - | 7116 | begin |
|
| - | 7117 | fx := 0; |
|
| - | 7118 | fy := 0; |
|
| - | 7119 | end |
|
| - | 7120 | else |
|
| - | 7121 | begin |
|
| - | 7122 | theta := ArcTan2(dx, dy) - r / Amount - OFFSET; |
|
| - | 7123 | fx := r * Cos(theta); |
|
| - | 7124 | fy := r * Sin(theta); |
|
| - | 7125 | end; |
|
| - | 7126 | fx := fx + fxmid; |
|
| - | 7127 | fy := fy + fymid; |
|
| - | 7128 | ||
| - | 7129 | ify := Trunc(fy); |
|
| - | 7130 | ifx := Trunc(fx); |
|
| - | 7131 | // Calculate the weights. |
|
| - | 7132 | if fy >= 0 then |
|
| - | 7133 | begin |
|
| - | 7134 | weight_y[1] := fy - ify; |
|
| - | 7135 | weight_y[0] := 1 - weight_y[1]; |
|
| - | 7136 | end |
|
| - | 7137 | else |
|
| - | 7138 | begin |
|
| - | 7139 | weight_y[0] := -(fy - ify); |
|
| - | 7140 | weight_y[1] := 1 - weight_y[0]; |
|
| - | 7141 | end; |
|
| - | 7142 | if fx >= 0 then |
|
| - | 7143 | begin |
|
| - | 7144 | weight_x[1] := fx - ifx; |
|
| - | 7145 | weight_x[0] := 1 - weight_x[1]; |
|
| - | 7146 | end |
|
| - | 7147 | else |
|
| - | 7148 | begin |
|
| - | 7149 | weight_x[0] := -(fx - ifx); |
|
| - | 7150 | Weight_x[1] := 1 - weight_x[0]; |
|
| - | 7151 | end; |
|
| - | 7152 | ||
| - | 7153 | if ifx < 0 then |
|
| - | 7154 | ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width) |
|
| - | 7155 | else if ifx > Bmp.Width - 1 then |
|
| - | 7156 | ifx := ifx mod Bmp.Width; |
|
| - | 7157 | if ify < 0 then |
|
| - | 7158 | ify := Bmp.Height - 1 - (-ify mod Bmp.Height) |
|
| - | 7159 | else if ify > Bmp.Height - 1 then |
|
| - | 7160 | ify := ify mod Bmp.Height; |
|
| - | 7161 | ||
| - | 7162 | total_red := 0.0; |
|
| - | 7163 | total_green := 0.0; |
|
| - | 7164 | total_blue := 0.0; |
|
| - | 7165 | for ix := 0 to 1 do |
|
| - | 7166 | begin |
|
| - | 7167 | for iy := 0 to 1 do |
|
| - | 7168 | begin |
|
| - | 7169 | if ify + iy < Bmp.Height then |
|
| - | 7170 | sli := Bmp.scanline[ify + iy] |
|
| - | 7171 | else |
|
| - | 7172 | sli := Bmp.scanline[Bmp.Height - ify - iy]; |
|
| - | 7173 | if ifx + ix < Bmp.Width then |
|
| - | 7174 | begin |
|
| - | 7175 | new_red := sli[(ifx + ix) * 3]; |
|
| - | 7176 | new_green := sli[(ifx + ix) * 3 + 1]; |
|
| - | 7177 | new_blue := sli[(ifx + ix) * 3 + 2]; |
|
| - | 7178 | end |
|
| - | 7179 | else |
|
| - | 7180 | begin |
|
| - | 7181 | new_red := sli[(Bmp.Width - ifx - ix) * 3]; |
|
| - | 7182 | new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1]; |
|
| - | 7183 | new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2]; |
|
| - | 7184 | end; |
|
| - | 7185 | weight := weight_x[ix] * weight_y[iy]; |
|
| - | 7186 | total_red := total_red + new_red * weight; |
|
| - | 7187 | total_green := total_green + new_green * weight; |
|
| - | 7188 | total_blue := total_blue + new_blue * weight; |
|
| - | 7189 | end; |
|
| - | 7190 | end; |
|
| - | 7191 | slo := Dst.scanline[ty]; |
|
| - | 7192 | slo[tx * 3] := Round(total_red); |
|
| - | 7193 | slo[tx * 3 + 1] := Round(total_green); |
|
| - | 7194 | slo[tx * 3 + 2] := Round(total_blue); |
|
| - | 7195 | end; |
|
| - | 7196 | end; |
|
| - | 7197 | end; |
|
| - | 7198 | var BB1, BB2: TDIB; |
|
| - | 7199 | begin |
|
| - | 7200 | BB1 := TDIB.Create; |
|
| - | 7201 | BB1.BitCount := 24; |
|
| - | 7202 | BB1.Assign(Self); |
|
| - | 7203 | BB2 := TDIB.Create; |
|
| - | 7204 | BB2.BitCount := 24; |
|
| - | 7205 | BB2.Assign(BB1); |
|
| - | 7206 | _Twist(BB1, BB2, Amount); |
|
| - | 7207 | Self.Assign(BB2); |
|
| - | 7208 | BB1.Free; |
|
| - | 7209 | BB2.Free; |
|
| - | 7210 | end; |
|
| - | 7211 | ||
| - | 7212 | procedure TDIB.DoTrace(Amount: Integer); |
|
| - | 7213 | procedure Trace(src: TDIB; intensity: Integer); |
|
| - | 7214 | var |
|
| - | 7215 | x, y, i: Integer; |
|
| - | 7216 | P1, P2, P3, P4: PByteArray; |
|
| - | 7217 | tb, TraceB: byte; |
|
| - | 7218 | hasb: Boolean; |
|
| - | 7219 | bitmap: TDIB; |
|
| - | 7220 | begin |
|
| - | 7221 | bitmap := TDIB.create; |
|
| - | 7222 | bitmap.width := src.width; |
|
| - | 7223 | bitmap.height := src.height; |
|
| - | 7224 | bitmap.canvas.draw(0, 0, src); |
|
| - | 7225 | bitmap.BitCount := 8; |
|
| - | 7226 | src.BitCount := 24; |
|
| - | 7227 | hasb := false; |
|
| - | 7228 | TraceB := $00; tb := 0; |
|
| - | 7229 | for i := 1 to Intensity do |
|
| - | 7230 | begin |
|
| - | 7231 | for y := 0 to BitMap.height - 2 do |
|
| - | 7232 | begin |
|
| - | 7233 | P1 := BitMap.ScanLine[y]; |
|
| - | 7234 | P2 := BitMap.scanline[y + 1]; |
|
| - | 7235 | P3 := src.scanline[y]; |
|
| - | 7236 | P4 := src.scanline[y + 1]; |
|
| - | 7237 | x := 0; |
|
| - | 7238 | repeat |
|
| - | 7239 | if p1[x] <> p1[x + 1] then |
|
| - | 7240 | begin |
|
| - | 7241 | if not hasb then |
|
| - | 7242 | begin |
|
| - | 7243 | tb := p1[x + 1]; |
|
| - | 7244 | hasb := true; |
|
| - | 7245 | p3[x * 3] := TraceB; |
|
| - | 7246 | p3[x * 3 + 1] := TraceB; |
|
| - | 7247 | p3[x * 3 + 2] := TraceB; |
|
| - | 7248 | end |
|
| - | 7249 | else |
|
| - | 7250 | begin |
|
| - | 7251 | if p1[x] <> tb then |
|
| - | 7252 | begin |
|
| - | 7253 | p3[x * 3] := TraceB; |
|
| - | 7254 | p3[x * 3 + 1] := TraceB; |
|
| - | 7255 | p3[x * 3 + 2] := TraceB; |
|
| - | 7256 | end |
|
| - | 7257 | else |
|
| - | 7258 | begin |
|
| - | 7259 | p3[(x + 1) * 3] := TraceB; |
|
| - | 7260 | p3[(x + 1) * 3 + 1] := TraceB; |
|
| - | 7261 | p3[(x + 1) * 3 + 1] := TraceB; |
|
| - | 7262 | end; |
|
| - | 7263 | end; |
|
| - | 7264 | end; |
|
| - | 7265 | if p1[x] <> p2[x] then |
|
| - | 7266 | begin |
|
| - | 7267 | if not hasb then |
|
| - | 7268 | begin |
|
| - | 7269 | tb := p2[x]; |
|
| - | 7270 | hasb := true; |
|
| - | 7271 | p3[x * 3] := TraceB; |
|
| - | 7272 | p3[x * 3 + 1] := TraceB; |
|
| - | 7273 | p3[x * 3 + 2] := TraceB; |
|
| - | 7274 | end |
|
| - | 7275 | else |
|
| - | 7276 | begin |
|
| - | 7277 | if p1[x] <> tb then |
|
| - | 7278 | begin |
|
| - | 7279 | p3[x * 3] := TraceB; |
|
| - | 7280 | p3[x * 3 + 1] := TraceB; |
|
| - | 7281 | p3[x * 3 + 2] := TraceB; |
|
| - | 7282 | end |
|
| - | 7283 | else |
|
| - | 7284 | begin |
|
| - | 7285 | p4[x * 3] := TraceB; |
|
| - | 7286 | p4[x * 3 + 1] := TraceB; |
|
| - | 7287 | p4[x * 3 + 2] := TraceB; |
|
| - | 7288 | end; |
|
| - | 7289 | end; |
|
| - | 7290 | end; |
|
| - | 7291 | inc(x); |
|
| - | 7292 | until x >= (BitMap.width - 2); |
|
| - | 7293 | end; |
|
| - | 7294 | if i > 1 then |
|
| - | 7295 | for y := BitMap.height - 1 downto 1 do |
|
| - | 7296 | begin |
|
| - | 7297 | P1 := BitMap.ScanLine[y]; |
|
| - | 7298 | P2 := BitMap.scanline[y - 1]; |
|
| - | 7299 | P3 := src.scanline[y]; |
|
| - | 7300 | P4 := src.scanline[y - 1]; |
|
| - | 7301 | x := Bitmap.width - 1; |
|
| - | 7302 | repeat |
|
| - | 7303 | if p1[x] <> p1[x - 1] then |
|
| - | 7304 | begin |
|
| - | 7305 | if not hasb then |
|
| - | 7306 | begin |
|
| - | 7307 | tb := p1[x - 1]; |
|
| - | 7308 | hasb := true; |
|
| - | 7309 | p3[x * 3] := TraceB; |
|
| - | 7310 | p3[x * 3 + 1] := TraceB; |
|
| - | 7311 | p3[x * 3 + 2] := TraceB; |
|
| - | 7312 | end |
|
| - | 7313 | else |
|
| - | 7314 | begin |
|
| - | 7315 | if p1[x] <> tb then |
|
| - | 7316 | begin |
|
| - | 7317 | p3[x * 3] := TraceB; |
|
| - | 7318 | p3[x * 3 + 1] := TraceB; |
|
| - | 7319 | p3[x * 3 + 2] := TraceB; |
|
| - | 7320 | end |
|
| - | 7321 | else |
|
| - | 7322 | begin |
|
| - | 7323 | p3[(x - 1) * 3] := TraceB; |
|
| - | 7324 | p3[(x - 1) * 3 + 1] := TraceB; |
|
| - | 7325 | p3[(x - 1) * 3 + 2] := TraceB; |
|
| - | 7326 | end; |
|
| - | 7327 | end; |
|
| - | 7328 | end; |
|
| - | 7329 | if p1[x] <> p2[x] then |
|
| - | 7330 | begin |
|
| - | 7331 | if not hasb then |
|
| - | 7332 | begin |
|
| - | 7333 | tb := p2[x]; |
|
| - | 7334 | hasb := true; |
|
| - | 7335 | p3[x * 3] := TraceB; |
|
| - | 7336 | p3[x * 3 + 1] := TraceB; |
|
| - | 7337 | p3[x * 3 + 2] := TraceB; |
|
| - | 7338 | end |
|
| - | 7339 | else |
|
| - | 7340 | begin |
|
| - | 7341 | if p1[x] <> tb then |
|
| - | 7342 | begin |
|
| - | 7343 | p3[x * 3] := TraceB; |
|
| - | 7344 | p3[x * 3 + 1] := TraceB; |
|
| - | 7345 | p3[x * 3 + 2] := TraceB; |
|
| - | 7346 | end |
|
| - | 7347 | else |
|
| - | 7348 | begin |
|
| - | 7349 | p4[x * 3] := TraceB; |
|
| - | 7350 | p4[x * 3 + 1] := TraceB; |
|
| - | 7351 | p4[x * 3 + 2] := TraceB; |
|
| - | 7352 | end; |
|
| - | 7353 | end; |
|
| - | 7354 | end; |
|
| - | 7355 | dec(x); |
|
| - | 7356 | until x <= 1; |
|
| - | 7357 | end; |
|
| - | 7358 | end; |
|
| - | 7359 | bitmap.free; |
|
| - | 7360 | end; |
|
| - | 7361 | var BB1, BB2: TDIB; |
|
| - | 7362 | begin |
|
| - | 7363 | BB1 := TDIB.Create; |
|
| - | 7364 | BB1.BitCount := 24; |
|
| - | 7365 | BB1.Assign(Self); |
|
| - | 7366 | BB2 := TDIB.Create; |
|
| - | 7367 | BB2.BitCount := 24; |
|
| - | 7368 | BB2.Assign(BB1); |
|
| - | 7369 | Trace(BB2, Amount); |
|
| - | 7370 | Self.Assign(BB2); |
|
| - | 7371 | BB1.Free; |
|
| - | 7372 | BB2.Free; |
|
| - | 7373 | end; |
|
| - | 7374 | ||
| - | 7375 | procedure TDIB.DoSplitlight(Amount: Integer); |
|
| - | 7376 | procedure Splitlight(var clip: TDIB; amount: Integer); |
|
| - | 7377 | var |
|
| - | 7378 | x, y, i: Integer; |
|
| - | 7379 | p1: pbytearray; |
|
| - | 7380 | ||
| - | 7381 | function sinpixs(a: Integer): Integer; |
|
| - | 7382 | begin |
|
| - | 7383 | result := variant(sin(a / 255 * pi / 2) * 255); |
|
| - | 7384 | end; |
|
| - | 7385 | begin |
|
| - | 7386 | for i := 1 to amount do |
|
| - | 7387 | for y := 0 to clip.height - 1 do |
|
| - | 7388 | begin |
|
| - | 7389 | p1 := clip.scanline[y]; |
|
| - | 7390 | for x := 0 to clip.width - 1 do |
|
| - | 7391 | begin |
|
| - | 7392 | p1[x * 3] := sinpixs(p1[x * 3]); |
|
| - | 7393 | p1[x * 3 + 1] := sinpixs(p1[x * 3 + 1]); |
|
| - | 7394 | p1[x * 3 + 2] := sinpixs(p1[x * 3 + 2]); |
|
| - | 7395 | end; |
|
| - | 7396 | end; |
|
| - | 7397 | end; |
|
| - | 7398 | var BB1 {,BB2}: TDIB; |
|
| - | 7399 | begin |
|
| - | 7400 | BB1 := TDIB.Create; |
|
| - | 7401 | BB1.BitCount := 24; |
|
| - | 7402 | BB1.Assign(Self); |
|
| - | 7403 | // BB2 := TDIB.Create; |
|
| - | 7404 | // BB2.BitCount := 24; |
|
| - | 7405 | // BB2.Assign (BB1); |
|
| - | 7406 | Splitlight(BB1, Amount); |
|
| - | 7407 | Self.Assign(BB1); |
|
| - | 7408 | BB1.Free; |
|
| - | 7409 | // BB2.Free; |
|
| - | 7410 | end; |
|
| - | 7411 | ||
| - | 7412 | procedure TDIB.DoTile(Amount: Integer); |
|
| - | 7413 | procedure SmoothResize(var Src, Dst: TDIB); |
|
| - | 7414 | var |
|
| - | 7415 | x, y, xP, yP, |
|
| - | 7416 | yP2, xP2: Integer; |
|
| - | 7417 | Read, Read2: PByteArray; |
|
| - | 7418 | t, z, z2, iz2: Integer; |
|
| - | 7419 | pc: PBytearray; |
|
| - | 7420 | w1, w2, w3, w4: Integer; |
|
| - | 7421 | Col1r, col1g, col1b, Col2r, col2g, col2b: byte; |
|
| - | 7422 | begin |
|
| - | 7423 | xP2 := ((src.Width - 1) shl 15) div Dst.Width; |
|
| - | 7424 | yP2 := ((src.Height - 1) shl 15) div Dst.Height; |
|
| - | 7425 | yP := 0; |
|
| - | 7426 | for y := 0 to Dst.Height - 1 do |
|
| - | 7427 | begin |
|
| - | 7428 | xP := 0; |
|
| - | 7429 | Read := src.ScanLine[yP shr 15]; |
|
| - | 7430 | if yP shr 16 < src.Height - 1 then |
|
| - | 7431 | Read2 := src.ScanLine[yP shr 15 + 1] |
|
| - | 7432 | else |
|
| - | 7433 | Read2 := src.ScanLine[yP shr 15]; |
|
| - | 7434 | pc := Dst.scanline[y]; |
|
| - | 7435 | z2 := yP and $7FFF; |
|
| - | 7436 | iz2 := $8000 - z2; |
|
| - | 7437 | for x := 0 to Dst.Width - 1 do |
|
| - | 7438 | begin |
|
| - | 7439 | t := xP shr 15; |
|
| - | 7440 | Col1r := Read[t * 3]; |
|
| - | 7441 | Col1g := Read[t * 3 + 1]; |
|
| - | 7442 | Col1b := Read[t * 3 + 2]; |
|
| - | 7443 | Col2r := Read2[t * 3]; |
|
| - | 7444 | Col2g := Read2[t * 3 + 1]; |
|
| - | 7445 | Col2b := Read2[t * 3 + 2]; |
|
| - | 7446 | z := xP and $7FFF; |
|
| - | 7447 | w2 := (z * iz2) shr 15; |
|
| - | 7448 | w1 := iz2 - w2; |
|
| - | 7449 | w4 := (z * z2) shr 15; |
|
| - | 7450 | w3 := z2 - w4; |
|
| - | 7451 | pc[x * 3 + 2] := |
|
| - | 7452 | (Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 + |
|
| - | 7453 | Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15; |
|
| - | 7454 | pc[x * 3 + 1] := |
|
| - | 7455 | (Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 + |
|
| - | 7456 | Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15; |
|
| - | 7457 | pc[x * 3] := |
|
| - | 7458 | (Col1r * w1 + Read2[(t + 1) * 3] * w2 + |
|
| - | 7459 | Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15; |
|
| - | 7460 | Inc(xP, xP2); |
|
| - | 7461 | end; |
|
| - | 7462 | Inc(yP, yP2); |
|
| - | 7463 | end; |
|
| - | 7464 | end; |
|
| - | 7465 | procedure Tile(src, dst: TDIB; amount: Integer); |
|
| - | 7466 | var |
|
| - | 7467 | w, h, w2, h2, i, j: Integer; |
|
| - | 7468 | bm: TDIB; |
|
| - | 7469 | begin |
|
| - | 7470 | w := src.width; |
|
| - | 7471 | h := src.height; |
|
| - | 7472 | dst.width := w; |
|
| - | 7473 | dst.height := h; |
|
| - | 7474 | dst.Canvas.draw(0, 0, src); |
|
| - | 7475 | if (amount <= 0) or ((w div amount) < 5) or ((h div amount) < 5) then exit; |
|
| - | 7476 | h2 := h div amount; |
|
| - | 7477 | w2 := w div amount; |
|
| - | 7478 | bm := TDIB.create; |
|
| - | 7479 | bm.width := w2; |
|
| - | 7480 | bm.height := h2; |
|
| - | 7481 | bm.BitCount := 24; |
|
| - | 7482 | smoothresize(src, bm); |
|
| - | 7483 | for j := 0 to amount - 1 do |
|
| - | 7484 | for i := 0 to amount - 1 do |
|
| - | 7485 | dst.canvas.Draw(i * w2, j * h2, bm); |
|
| - | 7486 | bm.free; |
|
| - | 7487 | end; |
|
| - | 7488 | var BB1, BB2: TDIB; |
|
| - | 7489 | begin |
|
| - | 7490 | BB1 := TDIB.Create; |
|
| - | 7491 | BB1.BitCount := 24; |
|
| - | 7492 | BB1.Assign(Self); |
|
| - | 7493 | BB2 := TDIB.Create; |
|
| - | 7494 | BB2.BitCount := 24; |
|
| - | 7495 | BB2.Assign(BB1); |
|
| - | 7496 | Tile(BB1, BB2, Amount); |
|
| - | 7497 | Self.Assign(BB2); |
|
| - | 7498 | BB1.Free; |
|
| - | 7499 | BB2.Free; |
|
| - | 7500 | end; |
|
| - | 7501 | ||
| - | 7502 | procedure TDIB.DoSpotLight(Amount: Integer; Spot: TRect); |
|
| - | 7503 | procedure SpotLight(var src: TDIB; Amount: Integer; Spot: TRect); |
|
| - | 7504 | var |
|
| - | 7505 | bm, z: TDIB; |
|
| - | 7506 | w, h: Integer; |
|
| - | 7507 | begin |
|
| - | 7508 | z := TDIB.Create; |
|
| - | 7509 | try |
|
| - | 7510 | z.SetSize(src.Width, src.Height, 24); |
|
| - | 7511 | z.DrawTo(src, 0, 0, src.Width, src.Height, 0, 0); |
|
| - | 7512 | w := z.Width; |
|
| - | 7513 | h := z.Height; |
|
| - | 7514 | bm := TDIB.create; |
|
| - | 7515 | try |
|
| - | 7516 | bm.Width := w; |
|
| - | 7517 | bm.Height := h; |
|
| - | 7518 | bm.Canvas.Brush.color := clblack; |
|
| - | 7519 | bm.Canvas.FillRect(rect(0, 0, w, h)); |
|
| - | 7520 | bm.Canvas.Brush.Color := clwhite; |
|
| - | 7521 | bm.Canvas.Ellipse(Spot.left, spot.top, spot.right, spot.bottom); |
|
| - | 7522 | bm.Transparent := true; |
|
| - | 7523 | z.Canvas.CopyMode := cmSrcAnd; {as transparentcolor for white} |
|
| - | 7524 | z.Canvas.Draw(0, 0, src); |
|
| - | 7525 | z.Canvas.Draw(0, 0, bm); |
|
| - | 7526 | src.Darkness(Amount); |
|
| - | 7527 | src.Canvas.CopyMode := cmSrcPaint; |
|
| - | 7528 | src.DrawTransparent(z, 0, 0, z.Width, z.Height, 0, 0, clBlack); |
|
| - | 7529 | finally |
|
| - | 7530 | bm.Free; |
|
| - | 7531 | end; |
|
| - | 7532 | finally |
|
| - | 7533 | z.Free |
|
| - | 7534 | end; |
|
| - | 7535 | end; |
|
| - | 7536 | var BB1, BB2: TDIB; |
|
| - | 7537 | begin |
|
| - | 7538 | BB1 := TDIB.Create; |
|
| - | 7539 | BB1.BitCount := 24; |
|
| - | 7540 | BB1.Assign(Self); |
|
| - | 7541 | BB2 := TDIB.Create; |
|
| - | 7542 | BB2.BitCount := 24; |
|
| - | 7543 | BB2.Assign(BB1); |
|
| - | 7544 | SpotLight(BB2, Amount, Spot); |
|
| - | 7545 | Self.Assign(BB2); |
|
| - | 7546 | BB1.Free; |
|
| - | 7547 | BB2.Free; |
|
| - | 7548 | end; |
|
| - | 7549 | ||
| - | 7550 | procedure TDIB.DoEmboss; |
|
| - | 7551 | procedure Emboss(var Bmp: TDIB); |
|
| - | 7552 | var |
|
| - | 7553 | x, y: Integer; |
|
| - | 7554 | p1, p2: Pbytearray; |
|
| - | 7555 | begin |
|
| - | 7556 | for y := 0 to Bmp.Height - 2 do |
|
| - | 7557 | begin |
|
| - | 7558 | p1 := bmp.scanline[y]; |
|
| - | 7559 | p2 := bmp.scanline[y + 1]; |
|
| - | 7560 | for x := 0 to Bmp.Width - 4 do |
|
| - | 7561 | begin |
|
| - | 7562 | p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1; |
|
| - | 7563 | p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1; |
|
| - | 7564 | p1[x * 3 + 2] := (p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1; |
|
| - | 7565 | end; |
|
| - | 7566 | end; |
|
| - | 7567 | end; |
|
| - | 7568 | var BB1, BB2: TDIB; |
|
| - | 7569 | begin |
|
| - | 7570 | BB1 := TDIB.Create; |
|
| - | 7571 | BB1.BitCount := 24; |
|
| - | 7572 | BB1.Assign(Self); |
|
| - | 7573 | BB2 := TDIB.Create; |
|
| - | 7574 | BB2.BitCount := 24; |
|
| - | 7575 | BB2.Assign(BB1); |
|
| - | 7576 | Emboss(BB2); |
|
| - | 7577 | Self.Assign(BB2); |
|
| - | 7578 | BB1.Free; |
|
| - | 7579 | BB2.Free; |
|
| - | 7580 | end; |
|
| - | 7581 | ||
| - | 7582 | procedure TDIB.DoSolorize(Amount: Integer); |
|
| - | 7583 | procedure Solorize(src, dst: TDIB; amount: Integer); |
|
| - | 7584 | var |
|
| - | 7585 | w, h, x, y: Integer; |
|
| - | 7586 | ps, pd: pbytearray; |
|
| - | 7587 | c: Integer; |
|
| - | 7588 | begin |
|
| - | 7589 | w := src.width; |
|
| - | 7590 | h := src.height; |
|
| - | 7591 | src.BitCount := 24; |
|
| - | 7592 | dst.BitCount := 24; |
|
| - | 7593 | for y := 0 to h - 1 do |
|
| - | 7594 | begin |
|
| - | 7595 | ps := src.scanline[y]; |
|
| - | 7596 | pd := dst.scanline[y]; |
|
| - | 7597 | for x := 0 to w - 1 do |
|
| - | 7598 | begin |
|
| - | 7599 | c := (ps[x * 3] + ps[x * 3 + 1] + ps[x * 3 + 2]) div 3; |
|
| - | 7600 | if c > amount then |
|
| - | 7601 | begin |
|
| - | 7602 | pd[x * 3] := 255 - ps[x * 3]; |
|
| - | 7603 | pd[x * 3 + 1] := 255 - ps[x * 3 + 1]; |
|
| - | 7604 | pd[x * 3 + 2] := 255 - ps[x * 3 + 2]; |
|
| - | 7605 | end |
|
| - | 7606 | else |
|
| - | 7607 | begin |
|
| - | 7608 | pd[x * 3] := ps[x * 3]; |
|
| - | 7609 | pd[x * 3 + 1] := ps[x * 3 + 1]; |
|
| - | 7610 | pd[x * 3 + 2] := ps[x * 3 + 2]; |
|
| - | 7611 | end; |
|
| - | 7612 | end; |
|
| - | 7613 | end; |
|
| - | 7614 | end; |
|
| - | 7615 | var BB1, BB2: TDIB; |
|
| - | 7616 | begin |
|
| - | 7617 | BB1 := TDIB.Create; |
|
| - | 7618 | BB1.BitCount := 24; |
|
| - | 7619 | BB1.Assign(Self); |
|
| - | 7620 | BB2 := TDIB.Create; |
|
| - | 7621 | BB2.BitCount := 24; |
|
| - | 7622 | BB2.Assign(BB1); |
|
| - | 7623 | Solorize(BB1, BB2, Amount); |
|
| - | 7624 | Self.Assign(BB2); |
|
| - | 7625 | BB1.Free; |
|
| - | 7626 | BB2.Free; |
|
| - | 7627 | end; |
|
| - | 7628 | ||
| - | 7629 | procedure TDIB.DoPosterize(Amount: Integer); |
|
| - | 7630 | procedure Posterize(src, dst: TDIB; amount: Integer); |
|
| - | 7631 | var |
|
| - | 7632 | w, h, x, y: Integer; |
|
| - | 7633 | ps, pd: pbytearray; |
|
| - | 7634 | begin |
|
| - | 7635 | w := src.width; |
|
| - | 7636 | h := src.height; |
|
| - | 7637 | src.BitCount := 24; |
|
| - | 7638 | dst.BitCount := 24; |
|
| - | 7639 | for y := 0 to h - 1 do |
|
| - | 7640 | begin |
|
| - | 7641 | ps := src.scanline[y]; |
|
| - | 7642 | pd := dst.scanline[y]; |
|
| - | 7643 | for x := 0 to w - 1 do |
|
| - | 7644 | begin |
|
| - | 7645 | pd[x * 3] := round(ps[x * 3] / amount) * amount; |
|
| - | 7646 | pd[x * 3 + 1] := round(ps[x * 3 + 1] / amount) * amount; |
|
| - | 7647 | pd[x * 3 + 2] := round(ps[x * 3 + 2] / amount) * amount; |
|
| - | 7648 | end; |
|
| - | 7649 | end; |
|
| - | 7650 | end; |
|
| - | 7651 | var BB1, BB2: TDIB; |
|
| - | 7652 | begin |
|
| - | 7653 | BB1 := TDIB.Create; |
|
| - | 7654 | BB1.BitCount := 24; |
|
| - | 7655 | BB1.Assign(Self); |
|
| - | 7656 | BB2 := TDIB.Create; |
|
| - | 7657 | BB2.BitCount := 24; |
|
| - | 7658 | BB2.Assign(BB1); |
|
| - | 7659 | Posterize(BB1, BB2, Amount); |
|
| - | 7660 | Self.Assign(BB2); |
|
| - | 7661 | BB1.Free; |
|
| - | 7662 | BB2.Free; |
|
| - | 7663 | end; |
|
| - | 7664 | ||
| - | 7665 | procedure TDIB.DoBrightness(Amount: Integer); |
|
| - | 7666 | procedure Brightness(src, dst: TDIB; level: Integer); |
|
| - | 7667 | const |
|
| - | 7668 | MaxPixelCount = 32768; |
|
| - | 7669 | type |
|
| - | 7670 | pRGBArray = ^TRGBArray; |
|
| - | 7671 | TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple; |
|
| - | 7672 | var |
|
| - | 7673 | i, j, value: Integer; |
|
| - | 7674 | OrigRow, DestRow: pRGBArray; |
|
| - | 7675 | begin |
|
| - | 7676 | // get brightness increment value |
|
| - | 7677 | value := level; |
|
| - | 7678 | src.BitCount := 24; |
|
| - | 7679 | dst.BitCount := 24; |
|
| - | 7680 | // for each row of pixels |
|
| - | 7681 | for i := 0 to src.Height - 1 do |
|
| - | 7682 | begin |
|
| - | 7683 | OrigRow := src.ScanLine[i]; |
|
| - | 7684 | DestRow := dst.ScanLine[i]; |
|
| - | 7685 | // for each pixel in row |
|
| - | 7686 | for j := 0 to src.Width - 1 do |
|
| - | 7687 | begin |
|
| - | 7688 | // add brightness value to pixel's RGB values |
|
| - | 7689 | if value > 0 then |
|
| - | 7690 | begin |
|
| - | 7691 | // RGB values must be less than 256 |
|
| - | 7692 | DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value); |
|
| - | 7693 | DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value); |
|
| - | 7694 | DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value); |
|
| - | 7695 | end |
|
| - | 7696 | else |
|
| - | 7697 | begin |
|
| - | 7698 | // RGB values must be greater or equal than 0 |
|
| - | 7699 | DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value); |
|
| - | 7700 | DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value); |
|
| - | 7701 | DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value); |
|
| - | 7702 | end; |
|
| - | 7703 | end; |
|
| - | 7704 | end; |
|
| - | 7705 | end; |
|
| - | 7706 | var BB1, BB2: TDIB; |
|
| - | 7707 | begin |
|
| - | 7708 | BB1 := TDIB.Create; |
|
| - | 7709 | BB1.BitCount := 24; |
|
| - | 7710 | BB1.Assign(Self); |
|
| - | 7711 | BB2 := TDIB.Create; |
|
| - | 7712 | BB2.BitCount := 24; |
|
| - | 7713 | BB2.Assign(BB1); |
|
| - | 7714 | Brightness(BB1, BB2, Amount); |
|
| - | 7715 | Self.Assign(BB2); |
|
| - | 7716 | BB1.Free; |
|
| - | 7717 | BB2.Free; |
|
| - | 7718 | end; |
|
| - | 7719 | ||
| - | 7720 | procedure TDIB.DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample); |
|
| - | 7721 | procedure Resample(Src, Dst: TDIB; filtertype: TFilterTypeResample; fwidth: single); |
|
| - | 7722 | // ----------------------------------------------------------------------------- |
|
| - | 7723 | // |
|
| - | 7724 | // Filter functions |
|
| - | 7725 | // |
|
| - | 7726 | // ----------------------------------------------------------------------------- |
|
| - | 7727 | ||
| - | 7728 | // Hermite filter |
|
| - | 7729 | function HermiteFilter(Value: Single): Single; |
|
| - | 7730 | begin |
|
| - | 7731 | // f(t) = 2|t|^3 - 3|t|^2 + 1, -1 <= t <= 1 |
|
| - | 7732 | if (Value < 0.0) then |
|
| - | 7733 | Value := -Value; |
|
| - | 7734 | if (Value < 1.0) then |
|
| - | 7735 | Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0 |
|
| - | 7736 | else |
|
| - | 7737 | Result := 0.0; |
|
| - | 7738 | end; |
|
| - | 7739 | ||
| - | 7740 | // Box filter |
|
| - | 7741 | // a.k.a. "Nearest Neighbour" filter |
|
| - | 7742 | // anme: I have not been able to get acceptable |
|
| - | 7743 | // results with this filter for subsampling. |
|
| - | 7744 | function BoxFilter(Value: Single): Single; |
|
| - | 7745 | begin |
|
| - | 7746 | if (Value > -0.5) and (Value <= 0.5) then |
|
| - | 7747 | Result := 1.0 |
|
| - | 7748 | else |
|
| - | 7749 | Result := 0.0; |
|
| - | 7750 | end; |
|
| - | 7751 | ||
| - | 7752 | // Triangle filter |
|
| - | 7753 | // a.k.a. "Linear" or "Bilinear" filter |
|
| - | 7754 | function TriangleFilter(Value: Single): Single; |
|
| - | 7755 | begin |
|
| - | 7756 | if (Value < 0.0) then |
|
| - | 7757 | Value := -Value; |
|
| - | 7758 | if (Value < 1.0) then |
|
| - | 7759 | Result := 1.0 - Value |
|
| - | 7760 | else |
|
| - | 7761 | Result := 0.0; |
|
| - | 7762 | end; |
|
| - | 7763 | ||
| - | 7764 | // Bell filter |
|
| - | 7765 | function BellFilter(Value: Single): Single; |
|
| - | 7766 | begin |
|
| - | 7767 | if (Value < 0.0) then |
|
| - | 7768 | Value := -Value; |
|
| - | 7769 | if (Value < 0.5) then |
|
| - | 7770 | Result := 0.75 - Sqr(Value) |
|
| - | 7771 | else |
|
| - | 7772 | if (Value < 1.5) then |
|
| - | 7773 | begin |
|
| - | 7774 | Value := Value - 1.5; |
|
| - | 7775 | Result := 0.5 * Sqr(Value); |
|
| - | 7776 | end |
|
| - | 7777 | else |
|
| - | 7778 | Result := 0.0; |
|
| - | 7779 | end; |
|
| - | 7780 | ||
| - | 7781 | // B-spline filter |
|
| - | 7782 | function SplineFilter(Value: Single): Single; |
|
| - | 7783 | var |
|
| - | 7784 | tt: single; |
|
| - | 7785 | begin |
|
| - | 7786 | if (Value < 0.0) then |
|
| - | 7787 | Value := -Value; |
|
| - | 7788 | if (Value < 1.0) then |
|
| - | 7789 | begin |
|
| - | 7790 | tt := Sqr(Value); |
|
| - | 7791 | Result := 0.5 * tt * Value - tt + 2.0 / 3.0; |
|
| - | 7792 | end |
|
| - | 7793 | else |
|
| - | 7794 | if (Value < 2.0) then |
|
| - | 7795 | begin |
|
| - | 7796 | Value := 2.0 - Value; |
|
| - | 7797 | Result := 1.0 / 6.0 * Sqr(Value) * Value; |
|
| - | 7798 | end |
|
| - | 7799 | else |
|
| - | 7800 | Result := 0.0; |
|
| - | 7801 | end; |
|
| - | 7802 | ||
| - | 7803 | // Lanczos3 filter |
|
| - | 7804 | function Lanczos3Filter(Value: Single): Single; |
|
| - | 7805 | function SinC(Value: Single): Single; |
|
| - | 7806 | begin |
|
| - | 7807 | if (Value <> 0.0) then |
|
| - | 7808 | begin |
|
| - | 7809 | Value := Value * Pi; |
|
| - | 7810 | Result := sin(Value) / Value |
|
| - | 7811 | end |
|
| - | 7812 | else |
|
| - | 7813 | Result := 1.0; |
|
| - | 7814 | end; |
|
| - | 7815 | begin |
|
| - | 7816 | if (Value < 0.0) then |
|
| - | 7817 | Value := -Value; |
|
| - | 7818 | if (Value < 3.0) then |
|
| - | 7819 | Result := SinC(Value) * SinC(Value / 3.0) |
|
| - | 7820 | else |
|
| - | 7821 | Result := 0.0; |
|
| - | 7822 | end; |
|
| - | 7823 | ||
| - | 7824 | function MitchellFilter(Value: Single): Single; |
|
| - | 7825 | const |
|
| - | 7826 | B = (1.0 / 3.0); |
|
| - | 7827 | C = (1.0 / 3.0); |
|
| - | 7828 | var |
|
| - | 7829 | tt: single; |
|
| - | 7830 | begin |
|
| - | 7831 | if (Value < 0.0) then |
|
| - | 7832 | Value := -Value; |
|
| - | 7833 | tt := Sqr(Value); |
|
| - | 7834 | if (Value < 1.0) then |
|
| - | 7835 | begin |
|
| - | 7836 | Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt)) |
|
| - | 7837 | + ((-18.0 + 12.0 * B + 6.0 * C) * tt) |
|
| - | 7838 | + (6.0 - 2 * B)); |
|
| - | 7839 | Result := Value / 6.0; |
|
| - | 7840 | end |
|
| - | 7841 | else |
|
| - | 7842 | if (Value < 2.0) then |
|
| - | 7843 | begin |
|
| - | 7844 | Value := (((-1.0 * B - 6.0 * C) * (Value * tt)) |
|
| - | 7845 | + ((6.0 * B + 30.0 * C) * tt) |
|
| - | 7846 | + ((-12.0 * B - 48.0 * C) * Value) |
|
| - | 7847 | + (8.0 * B + 24 * C)); |
|
| - | 7848 | Result := Value / 6.0; |
|
| - | 7849 | end |
|
| - | 7850 | else |
|
| - | 7851 | Result := 0.0; |
|
| - | 7852 | end; |
|
| - | 7853 | ||
| - | 7854 | // ----------------------------------------------------------------------------- |
|
| - | 7855 | // |
|
| - | 7856 | // Interpolator |
|
| - | 7857 | // |
|
| - | 7858 | // ----------------------------------------------------------------------------- |
|
| - | 7859 | type |
|
| - | 7860 | // Contributor for a pixel |
|
| - | 7861 | TContributor = record |
|
| - | 7862 | pixel: Integer; // Source pixel |
|
| - | 7863 | weight: single; // Pixel weight |
|
| - | 7864 | end; |
|
| - | 7865 | ||
| - | 7866 | TContributorList = array[0..0] of TContributor; |
|
| - | 7867 | PContributorList = ^TContributorList; |
|
| - | 7868 | ||
| - | 7869 | // List of source pixels contributing to a destination pixel |
|
| - | 7870 | TCList = record |
|
| - | 7871 | n: Integer; |
|
| - | 7872 | p: PContributorList; |
|
| - | 7873 | end; |
|
| - | 7874 | ||
| - | 7875 | TCListList = array[0..0] of TCList; |
|
| - | 7876 | PCListList = ^TCListList; |
|
| - | 7877 | ||
| - | 7878 | TRGB = packed record |
|
| - | 7879 | r, g, b: single; |
|
| - | 7880 | end; |
|
| - | 7881 | ||
| - | 7882 | // Physical bitmap pixel |
|
| - | 7883 | TColorRGB = packed record |
|
| - | 7884 | r, g, b: BYTE; |
|
| - | 7885 | end; |
|
| - | 7886 | PColorRGB = ^TColorRGB; |
|
| - | 7887 | ||
| - | 7888 | // Physical bitmap scanline (row) |
|
| - | 7889 | TRGBList = packed array[0..0] of TColorRGB; |
|
| - | 7890 | PRGBList = ^TRGBList; |
|
| - | 7891 | ||
| - | 7892 | var |
|
| - | 7893 | xscale, yscale: single; // Zoom scale factors |
|
| - | 7894 | i, j, k: Integer; // Loop variables |
|
| - | 7895 | center: single; // Filter calculation variables |
|
| - | 7896 | width, fscale, weight: single; // Filter calculation variables |
|
| - | 7897 | left, right: Integer; // Filter calculation variables |
|
| - | 7898 | n: Integer; // Pixel number |
|
| - | 7899 | Work: TDIB; |
|
| - | 7900 | contrib: PCListList; |
|
| - | 7901 | rgb: TRGB; |
|
| - | 7902 | color: TColorRGB; |
|
| - | 7903 | {$IFDEF USE_SCANLINE} |
|
| - | 7904 | SourceLine, |
|
| - | 7905 | DestLine: PRGBList; |
|
| - | 7906 | SourcePixel, |
|
| - | 7907 | DestPixel: PColorRGB; |
|
| - | 7908 | Delta, |
|
| - | 7909 | DestDelta: Integer; |
|
| - | 7910 | {$ENDIF} |
|
| - | 7911 | SrcWidth, |
|
| - | 7912 | SrcHeight, |
|
| - | 7913 | DstWidth, |
|
| - | 7914 | DstHeight: Integer; |
|
| - | 7915 | ||
| - | 7916 | function Color2RGB(Color: TColor): TColorRGB; |
|
| - | 7917 | begin |
|
| - | 7918 | Result.r := Color and $000000FF; |
|
| - | 7919 | Result.g := (Color and $0000FF00) shr 8; |
|
| - | 7920 | Result.b := (Color and $00FF0000) shr 16; |
|
| - | 7921 | end; |
|
| - | 7922 | ||
| - | 7923 | function RGB2Color(Color: TColorRGB): TColor; |
|
| - | 7924 | begin |
|
| - | 7925 | Result := Color.r or (Color.g shl 8) or (Color.b shl 16); |
|
| - | 7926 | end; |
|
| - | 7927 | ||
| - | 7928 | begin |
|
| - | 7929 | DstWidth := Dst.Width; |
|
| - | 7930 | DstHeight := Dst.Height; |
|
| - | 7931 | SrcWidth := Src.Width; |
|
| - | 7932 | SrcHeight := Src.Height; |
|
| - | 7933 | if (SrcWidth < 1) or (SrcHeight < 1) then |
|
| - | 7934 | raise Exception.Create('Source bitmap too small'); |
|
| - | 7935 | ||
| - | 7936 | // Create intermediate image to hold horizontal zoom |
|
| - | 7937 | Work := TDIB.Create; |
|
| - | 7938 | try |
|
| - | 7939 | Work.Height := SrcHeight; |
|
| - | 7940 | Work.Width := DstWidth; |
|
| - | 7941 | // xscale := DstWidth / SrcWidth; |
|
| - | 7942 | // yscale := DstHeight / SrcHeight; |
|
| - | 7943 | // Improvement suggested by David Ullrich: |
|
| - | 7944 | if (SrcWidth = 1) then |
|
| - | 7945 | xscale := DstWidth / SrcWidth |
|
| - | 7946 | else |
|
| - | 7947 | xscale := (DstWidth - 1) / (SrcWidth - 1); |
|
| - | 7948 | if (SrcHeight = 1) then |
|
| - | 7949 | yscale := DstHeight / SrcHeight |
|
| - | 7950 | else |
|
| - | 7951 | yscale := (DstHeight - 1) / (SrcHeight - 1); |
|
| - | 7952 | // This implementation only works on 24-bit images because it uses |
|
| - | 7953 | // TDIB.Scanline |
|
| - | 7954 | {$IFDEF USE_SCANLINE} |
|
| - | 7955 | //Src.PixelFormat := pf24bit; |
|
| - | 7956 | Src.BitCount := 24; |
|
| - | 7957 | //Dst.PixelFormat := Src.PixelFormat; |
|
| - | 7958 | dst.BitCount := 24; |
|
| - | 7959 | //Work.PixelFormat := Src.PixelFormat; |
|
| - | 7960 | work.BitCount := 24; |
|
| - | 7961 | {$ENDIF} |
|
| - | 7962 | ||
| - | 7963 | // -------------------------------------------- |
|
| - | 7964 | // Pre-calculate filter contributions for a row |
|
| - | 7965 | // ----------------------------------------------- |
|
| - | 7966 | GetMem(contrib, DstWidth * sizeof(TCList)); |
|
| - | 7967 | // Horizontal sub-sampling |
|
| - | 7968 | // Scales from bigger to smaller width |
|
| - | 7969 | if (xscale < 1.0) then |
|
| - | 7970 | begin |
|
| - | 7971 | width := fwidth / xscale; |
|
| - | 7972 | fscale := 1.0 / xscale; |
|
| - | 7973 | for i := 0 to DstWidth - 1 do |
|
| - | 7974 | begin |
|
| - | 7975 | contrib^[i].n := 0; |
|
| - | 7976 | GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); |
|
| - | 7977 | center := i / xscale; |
|
| - | 7978 | // Original code: |
|
| - | 7979 | // left := ceil(center - width); |
|
| - | 7980 | // right := floor(center + width); |
|
| - | 7981 | left := floor(center - width); |
|
| - | 7982 | right := ceil(center + width); |
|
| - | 7983 | for j := left to right do |
|
| - | 7984 | begin |
|
| - | 7985 | case filtertype of |
|
| - | 7986 | ftrBox: weight := boxfilter((center - j) / fscale) / fscale; |
|
| - | 7987 | ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale; |
|
| - | 7988 | ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale; |
|
| - | 7989 | ftrBell: weight := bellfilter((center - j) / fscale) / fscale; |
|
| - | 7990 | ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale; |
|
| - | 7991 | ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale; |
|
| - | 7992 | ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale; |
|
| - | 7993 | else |
|
| - | 7994 | weight := 0 |
|
| - | 7995 | end; |
|
| - | 7996 | if (weight = 0.0) then |
|
| - | 7997 | continue; |
|
| - | 7998 | if (j < 0) then |
|
| - | 7999 | n := -j |
|
| - | 8000 | else if (j >= SrcWidth) then |
|
| - | 8001 | n := SrcWidth - j + SrcWidth - 1 |
|
| - | 8002 | else |
|
| - | 8003 | n := j; |
|
| - | 8004 | k := contrib^[i].n; |
|
| - | 8005 | contrib^[i].n := contrib^[i].n + 1; |
|
| - | 8006 | contrib^[i].p^[k].pixel := n; |
|
| - | 8007 | contrib^[i].p^[k].weight := weight; |
|
| - | 8008 | end; |
|
| - | 8009 | end; |
|
| - | 8010 | end |
|
| - | 8011 | else |
|
| - | 8012 | // Horizontal super-sampling |
|
| - | 8013 | // Scales from smaller to bigger width |
|
| - | 8014 | begin |
|
| - | 8015 | for i := 0 to DstWidth - 1 do |
|
| - | 8016 | begin |
|
| - | 8017 | contrib^[i].n := 0; |
|
| - | 8018 | GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); |
|
| - | 8019 | center := i / xscale; |
|
| - | 8020 | // Original code: |
|
| - | 8021 | // left := ceil(center - fwidth); |
|
| - | 8022 | // right := floor(center + fwidth); |
|
| - | 8023 | left := floor(center - fwidth); |
|
| - | 8024 | right := ceil(center + fwidth); |
|
| - | 8025 | for j := left to right do |
|
| - | 8026 | begin |
|
| - | 8027 | case filtertype of |
|
| - | 8028 | ftrBox: weight := boxfilter(center - j); |
|
| - | 8029 | ftrTriangle: weight := trianglefilter(center - j); |
|
| - | 8030 | ftrHermite: weight := hermitefilter(center - j); |
|
| - | 8031 | ftrBell: weight := bellfilter(center - j); |
|
| - | 8032 | ftrBSpline: weight := splinefilter(center - j); |
|
| - | 8033 | ftrLanczos3: weight := Lanczos3filter(center - j); |
|
| - | 8034 | ftrMitchell: weight := Mitchellfilter(center - j); |
|
| - | 8035 | else |
|
| - | 8036 | weight := 0 |
|
| - | 8037 | end; |
|
| - | 8038 | if (weight = 0.0) then |
|
| - | 8039 | continue; |
|
| - | 8040 | if (j < 0) then |
|
| - | 8041 | n := -j |
|
| - | 8042 | else if (j >= SrcWidth) then |
|
| - | 8043 | n := SrcWidth - j + SrcWidth - 1 |
|
| - | 8044 | else |
|
| - | 8045 | n := j; |
|
| - | 8046 | k := contrib^[i].n; |
|
| - | 8047 | contrib^[i].n := contrib^[i].n + 1; |
|
| - | 8048 | contrib^[i].p^[k].pixel := n; |
|
| - | 8049 | contrib^[i].p^[k].weight := weight; |
|
| - | 8050 | end; |
|
| - | 8051 | end; |
|
| - | 8052 | end; |
|
| - | 8053 | ||
| - | 8054 | // ---------------------------------------------------- |
|
| - | 8055 | // Apply filter to sample horizontally from Src to Work |
|
| - | 8056 | // ---------------------------------------------------- |
|
| - | 8057 | for k := 0 to SrcHeight - 1 do |
|
| - | 8058 | begin |
|
| - | 8059 | {$IFDEF USE_SCANLINE} |
|
| - | 8060 | SourceLine := Src.ScanLine[k]; |
|
| - | 8061 | DestPixel := Work.ScanLine[k]; |
|
| - | 8062 | {$ENDIF} |
|
| - | 8063 | for i := 0 to DstWidth - 1 do |
|
| - | 8064 | begin |
|
| - | 8065 | rgb.r := 0.0; |
|
| - | 8066 | rgb.g := 0.0; |
|
| - | 8067 | rgb.b := 0.0; |
|
| - | 8068 | for j := 0 to contrib^[i].n - 1 do |
|
| - | 8069 | begin |
|
| - | 8070 | {$IFDEF USE_SCANLINE} |
|
| - | 8071 | color := SourceLine^[contrib^[i].p^[j].pixel]; |
|
| - | 8072 | {$ELSE} |
|
| - | 8073 | color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]); |
|
| - | 8074 | {$ENDIF} |
|
| - | 8075 | weight := contrib^[i].p^[j].weight; |
|
| - | 8076 | if (weight = 0.0) then |
|
| - | 8077 | continue; |
|
| - | 8078 | rgb.r := rgb.r + color.r * weight; |
|
| - | 8079 | rgb.g := rgb.g + color.g * weight; |
|
| - | 8080 | rgb.b := rgb.b + color.b * weight; |
|
| - | 8081 | end; |
|
| - | 8082 | if (rgb.r > 255.0) then |
|
| - | 8083 | color.r := 255 |
|
| - | 8084 | else if (rgb.r < 0.0) then |
|
| - | 8085 | color.r := 0 |
|
| - | 8086 | else |
|
| - | 8087 | color.r := round(rgb.r); |
|
| - | 8088 | if (rgb.g > 255.0) then |
|
| - | 8089 | color.g := 255 |
|
| - | 8090 | else if (rgb.g < 0.0) then |
|
| - | 8091 | color.g := 0 |
|
| - | 8092 | else |
|
| - | 8093 | color.g := round(rgb.g); |
|
| - | 8094 | if (rgb.b > 255.0) then |
|
| - | 8095 | color.b := 255 |
|
| - | 8096 | else if (rgb.b < 0.0) then |
|
| - | 8097 | color.b := 0 |
|
| - | 8098 | else |
|
| - | 8099 | color.b := round(rgb.b); |
|
| - | 8100 | {$IFDEF USE_SCANLINE} |
|
| - | 8101 | // Set new pixel value |
|
| - | 8102 | DestPixel^ := color; |
|
| - | 8103 | // Move on to next column |
|
| - | 8104 | inc(DestPixel); |
|
| - | 8105 | {$ELSE} |
|
| - | 8106 | Work.Canvas.Pixels[i, k] := RGB2Color(color); |
|
| - | 8107 | {$ENDIF} |
|
| - | 8108 | end; |
|
| - | 8109 | end; |
|
| - | 8110 | ||
| - | 8111 | // Free the memory allocated for horizontal filter weights |
|
| - | 8112 | for i := 0 to DstWidth - 1 do |
|
| - | 8113 | FreeMem(contrib^[i].p); |
|
| - | 8114 | ||
| - | 8115 | FreeMem(contrib); |
|
| - | 8116 | ||
| - | 8117 | // ----------------------------------------------- |
|
| - | 8118 | // Pre-calculate filter contributions for a column |
|
| - | 8119 | // ----------------------------------------------- |
|
| - | 8120 | GetMem(contrib, DstHeight * sizeof(TCList)); |
|
| - | 8121 | // Vertical sub-sampling |
|
| - | 8122 | // Scales from bigger to smaller height |
|
| - | 8123 | if (yscale < 1.0) then |
|
| - | 8124 | begin |
|
| - | 8125 | width := fwidth / yscale; |
|
| - | 8126 | fscale := 1.0 / yscale; |
|
| - | 8127 | for i := 0 to DstHeight - 1 do |
|
| - | 8128 | begin |
|
| - | 8129 | contrib^[i].n := 0; |
|
| - | 8130 | GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor)); |
|
| - | 8131 | center := i / yscale; |
|
| - | 8132 | // Original code: |
|
| - | 8133 | // left := ceil(center - width); |
|
| - | 8134 | // right := floor(center + width); |
|
| - | 8135 | left := floor(center - width); |
|
| - | 8136 | right := ceil(center + width); |
|
| - | 8137 | for j := left to right do |
|
| - | 8138 | begin |
|
| - | 8139 | case filtertype of |
|
| - | 8140 | ftrBox: weight := boxfilter((center - j) / fscale) / fscale; |
|
| - | 8141 | ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale; |
|
| - | 8142 | ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale; |
|
| - | 8143 | ftrBell: weight := bellfilter((center - j) / fscale) / fscale; |
|
| - | 8144 | ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale; |
|
| - | 8145 | ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale; |
|
| - | 8146 | ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale; |
|
| - | 8147 | else |
|
| - | 8148 | weight := 0 |
|
| - | 8149 | end; |
|
| - | 8150 | if (weight = 0.0) then |
|
| - | 8151 | continue; |
|
| - | 8152 | if (j < 0) then |
|
| - | 8153 | n := -j |
|
| - | 8154 | else if (j >= SrcHeight) then |
|
| - | 8155 | n := SrcHeight - j + SrcHeight - 1 |
|
| - | 8156 | else |
|
| - | 8157 | n := j; |
|
| - | 8158 | k := contrib^[i].n; |
|
| - | 8159 | contrib^[i].n := contrib^[i].n + 1; |
|
| - | 8160 | contrib^[i].p^[k].pixel := n; |
|
| - | 8161 | contrib^[i].p^[k].weight := weight; |
|
| - | 8162 | end; |
|
| - | 8163 | end |
|
| - | 8164 | end |
|
| - | 8165 | else |
|
| - | 8166 | // Vertical super-sampling |
|
| - | 8167 | // Scales from smaller to bigger height |
|
| - | 8168 | begin |
|
| - | 8169 | for i := 0 to DstHeight - 1 do |
|
| - | 8170 | begin |
|
| - | 8171 | contrib^[i].n := 0; |
|
| - | 8172 | GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor)); |
|
| - | 8173 | center := i / yscale; |
|
| - | 8174 | // Original code: |
|
| - | 8175 | // left := ceil(center - fwidth); |
|
| - | 8176 | // right := floor(center + fwidth); |
|
| - | 8177 | left := floor(center - fwidth); |
|
| - | 8178 | right := ceil(center + fwidth); |
|
| - | 8179 | for j := left to right do |
|
| - | 8180 | begin |
|
| - | 8181 | case filtertype of |
|
| - | 8182 | ftrBox: weight := boxfilter(center - j); |
|
| - | 8183 | ftrTriangle: weight := trianglefilter(center - j); |
|
| - | 8184 | ftrHermite: weight := hermitefilter(center - j); |
|
| - | 8185 | ftrBell: weight := bellfilter(center - j); |
|
| - | 8186 | ftrBSpline: weight := splinefilter(center - j); |
|
| - | 8187 | ftrLanczos3: weight := Lanczos3filter(center - j); |
|
| - | 8188 | ftrMitchell: weight := Mitchellfilter(center - j); |
|
| - | 8189 | else |
|
| - | 8190 | weight := 0 |
|
| - | 8191 | end; |
|
| - | 8192 | if (weight = 0.0) then |
|
| - | 8193 | continue; |
|
| - | 8194 | if (j < 0) then |
|
| - | 8195 | n := -j |
|
| - | 8196 | else if (j >= SrcHeight) then |
|
| - | 8197 | n := SrcHeight - j + SrcHeight - 1 |
|
| - | 8198 | else |
|
| - | 8199 | n := j; |
|
| - | 8200 | k := contrib^[i].n; |
|
| - | 8201 | contrib^[i].n := contrib^[i].n + 1; |
|
| - | 8202 | contrib^[i].p^[k].pixel := n; |
|
| - | 8203 | contrib^[i].p^[k].weight := weight; |
|
| - | 8204 | end; |
|
| - | 8205 | end; |
|
| - | 8206 | end; |
|
| - | 8207 | ||
| - | 8208 | // -------------------------------------------------- |
|
| - | 8209 | // Apply filter to sample vertically from Work to Dst |
|
| - | 8210 | // -------------------------------------------------- |
|
| - | 8211 | {$IFDEF USE_SCANLINE} |
|
| - | 8212 | SourceLine := Work.ScanLine[0]; |
|
| - | 8213 | Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine); |
|
| - | 8214 | DestLine := Dst.ScanLine[0]; |
|
| - | 8215 | DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine); |
|
| - | 8216 | {$ENDIF} |
|
| - | 8217 | for k := 0 to DstWidth - 1 do |
|
| - | 8218 | begin |
|
| - | 8219 | {$IFDEF USE_SCANLINE} |
|
| - | 8220 | DestPixel := pointer(DestLine); |
|
| - | 8221 | {$ENDIF} |
|
| - | 8222 | for i := 0 to DstHeight - 1 do |
|
| - | 8223 | begin |
|
| - | 8224 | rgb.r := 0; |
|
| - | 8225 | rgb.g := 0; |
|
| - | 8226 | rgb.b := 0; |
|
| - | 8227 | // weight := 0.0; |
|
| - | 8228 | for j := 0 to contrib^[i].n - 1 do |
|
| - | 8229 | begin |
|
| - | 8230 | {$IFDEF USE_SCANLINE} |
|
| - | 8231 | color := PColorRGB(Integer(SourceLine) + contrib^[i].p^[j].pixel * Delta)^; |
|
| - | 8232 | {$ELSE} |
|
| - | 8233 | color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]); |
|
| - | 8234 | {$ENDIF} |
|
| - | 8235 | weight := contrib^[i].p^[j].weight; |
|
| - | 8236 | if (weight = 0.0) then |
|
| - | 8237 | continue; |
|
| - | 8238 | rgb.r := rgb.r + color.r * weight; |
|
| - | 8239 | rgb.g := rgb.g + color.g * weight; |
|
| - | 8240 | rgb.b := rgb.b + color.b * weight; |
|
| - | 8241 | end; |
|
| - | 8242 | if (rgb.r > 255.0) then |
|
| - | 8243 | color.r := 255 |
|
| - | 8244 | else if (rgb.r < 0.0) then |
|
| - | 8245 | color.r := 0 |
|
| - | 8246 | else |
|
| - | 8247 | color.r := round(rgb.r); |
|
| - | 8248 | if (rgb.g > 255.0) then |
|
| - | 8249 | color.g := 255 |
|
| - | 8250 | else if (rgb.g < 0.0) then |
|
| - | 8251 | color.g := 0 |
|
| - | 8252 | else |
|
| - | 8253 | color.g := round(rgb.g); |
|
| - | 8254 | if (rgb.b > 255.0) then |
|
| - | 8255 | color.b := 255 |
|
| - | 8256 | else if (rgb.b < 0.0) then |
|
| - | 8257 | color.b := 0 |
|
| - | 8258 | else |
|
| - | 8259 | color.b := round(rgb.b); |
|
| - | 8260 | {$IFDEF USE_SCANLINE} |
|
| - | 8261 | DestPixel^ := color; |
|
| - | 8262 | inc(Integer(DestPixel), DestDelta); |
|
| - | 8263 | {$ELSE} |
|
| - | 8264 | Dst.Canvas.Pixels[k, i] := RGB2Color(color); |
|
| - | 8265 | {$ENDIF} |
|
| - | 8266 | end; |
|
| - | 8267 | {$IFDEF USE_SCANLINE} |
|
| - | 8268 | Inc(SourceLine, 1); |
|
| - | 8269 | Inc(DestLine, 1); |
|
| - | 8270 | {$ENDIF} |
|
| - | 8271 | end; |
|
| - | 8272 | ||
| - | 8273 | // Free the memory allocated for vertical filter weights |
|
| - | 8274 | for i := 0 to DstHeight - 1 do |
|
| - | 8275 | FreeMem(contrib^[i].p); |
|
| - | 8276 | ||
| - | 8277 | FreeMem(contrib); |
|
| - | 8278 | ||
| - | 8279 | finally |
|
| - | 8280 | Work.Free; |
|
| - | 8281 | end; |
|
| - | 8282 | end; |
|
| - | 8283 | var BB1, BB2: TDIB; |
|
| - | 8284 | begin |
|
| - | 8285 | BB1 := TDIB.Create; |
|
| - | 8286 | BB1.BitCount := 24; |
|
| - | 8287 | BB1.Assign(Self); |
|
| - | 8288 | BB2 := TDIB.Create; |
|
| - | 8289 | BB2.SetSize(AmountX, AmountY, 24); |
|
| - | 8290 | Resample(BB1, BB2, TypeResample, DefaultFilterRadius[TypeResample]); |
|
| - | 8291 | Self.Assign(BB2); |
|
| - | 8292 | BB1.Free; |
|
| - | 8293 | BB2.Free; |
|
| - | 8294 | end; |
|
| - | 8295 | ||
| - | 8296 | procedure TDIB.DoColorize(ForeColor, BackColor: TColor); |
|
| - | 8297 | procedure Colorize(src, dst: TDIB; iForeColor, iBackColor: TColor; iDither: Boolean{$IFDEF VER4UP} = False{$ENDIF}); |
|
| - | 8298 | {for monochromatic picture change colors} |
|
| - | 8299 | procedure InvertBitmap(Bmp: TDIB); |
|
| - | 8300 | begin |
|
| - | 8301 | Bmp.Canvas.CopyMode := cmDstInvert; |
|
| - | 8302 | Bmp.Canvas.CopyRect(rect(0, 0, Bmp.Width, Bmp.Height), |
|
| - | 8303 | Bmp.Canvas, rect(0, 0, Bmp.Width, Bmp.Height)); |
|
| - | 8304 | end; |
|
| - | 8305 | var |
|
| - | 8306 | fForeColor: TColor; |
|
| - | 8307 | fForeDither: Boolean; |
|
| - | 8308 | lTempBitmap: TDIB; |
|
| - | 8309 | lTempBitmap2: TDIB; |
|
| - | 8310 | lDitherBitmap: TDIB; |
|
| - | 8311 | lCRect: TRect; |
|
| - | 8312 | x, y, w, h: Integer; |
|
| - | 8313 | begin |
|
| - | 8314 | {--} |
|
| - | 8315 | //fColor := iBackColor; ; |
|
| - | 8316 | fForeColor := iForeColor; |
|
| - | 8317 | fForeDither := iDither; |
|
| - | 8318 | w := src.Width; |
|
| - | 8319 | h := src.Height; |
|
| - | 8320 | lDitherBitmap := nil; |
|
| - | 8321 | lTempBitmap := TDIB.Create; |
|
| - | 8322 | lTempBitmap.SetSize(w, h, 24); |
|
| - | 8323 | lTempBitmap2 := TDIB.Create; |
|
| - | 8324 | lTempBitmap2.SetSize(w, h, 24); |
|
| - | 8325 | lCRect := rect(0, 0, w, h); |
|
| - | 8326 | with lTempBitmap.Canvas do |
|
| - | 8327 | begin |
|
| - | 8328 | Brush.Style := bsSolid; |
|
| - | 8329 | Brush.Color := iBackColor; |
|
| - | 8330 | FillRect(lCRect); |
|
| - | 8331 | CopyMode := cmSrcInvert; |
|
| - | 8332 | CopyRect(lCRect, src.Canvas, lCRect); |
|
| - | 8333 | InvertBitmap(src); |
|
| - | 8334 | CopyMode := cmSrcPaint; |
|
| - | 8335 | CopyRect(lCRect, src.Canvas, lCRect); |
|
| - | 8336 | InvertBitmap(lTempBitmap); |
|
| - | 8337 | CopyMode := cmSrcInvert; |
|
| - | 8338 | CopyRect(lCRect, src.Canvas, lCRect); |
|
| - | 8339 | InvertBitmap(src); |
|
| - | 8340 | end; |
|
| - | 8341 | with lTempBitmap2.Canvas do |
|
| - | 8342 | begin |
|
| - | 8343 | Brush.Style := bsSolid; |
|
| - | 8344 | Brush.Color := clBlack; |
|
| - | 8345 | FillRect(lCRect); |
|
| - | 8346 | if fForeDither then |
|
| - | 8347 | begin |
|
| - | 8348 | InvertBitmap(src); |
|
| - | 8349 | lDitherBitmap := TDIB.Create; |
|
| - | 8350 | lDitherBitmap.SetSize(8, 8, 24); |
|
| - | 8351 | with lDitherBitmap.Canvas do |
|
| - | 8352 | begin |
|
| - | 8353 | for x := 0 to 7 do |
|
| - | 8354 | for y := 0 to 7 do |
|
| - | 8355 | if ((x mod 2 = 0) and (y mod 2 > 0)) or ((x mod 2 > 0) and (y mod 2 = 0)) then |
|
| - | 8356 | pixels[x, y] := fForeColor |
|
| - | 8357 | else |
|
| - | 8358 | pixels[x, y] := iBackColor; |
|
| - | 8359 | end; |
|
| - | 8360 | Brush.Bitmap.Assign(lDitherBitmap); |
|
| - | 8361 | end |
|
| - | 8362 | else |
|
| - | 8363 | begin |
|
| - | 8364 | Brush.Style := bsSolid; |
|
| - | 8365 | Brush.Color := fForeColor; |
|
| - | 8366 | end; |
|
| - | 8367 | if not fForeDither then |
|
| - | 8368 | InvertBitmap(src); |
|
| - | 8369 | CopyMode := cmPatPaint; |
|
| - | 8370 | CopyRect(lCRect, src.Canvas, lCRect); |
|
| - | 8371 | if fForeDither then |
|
| - | 8372 | if Assigned(lDitherBitmap) then |
|
| - | 8373 | lDitherBitmap.Free; |
|
| - | 8374 | CopyMode := cmSrcInvert; |
|
| - | 8375 | CopyRect(lCRect, src.Canvas, lCRect); |
|
| - | 8376 | end; |
|
| - | 8377 | lTempBitmap.Canvas.CopyMode := cmSrcInvert; |
|
| - | 8378 | lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect); |
|
| - | 8379 | InvertBitmap(src); |
|
| - | 8380 | lTempBitmap.Canvas.CopyMode := cmSrcErase; |
|
| - | 8381 | lTempBitmap.Canvas.Copyrect(lCRect, src.Canvas, lCRect); |
|
| - | 8382 | InvertBitmap(src); |
|
| - | 8383 | lTempBitmap.Canvas.CopyMode := cmSrcInvert; |
|
| - | 8384 | lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect); |
|
| - | 8385 | InvertBitmap(lTempBitmap); |
|
| - | 8386 | InvertBitmap(src); |
|
| - | 8387 | dst.Assign(lTempBitmap); |
|
| - | 8388 | lTempBitmap.Free; |
|
| - | 8389 | end; |
|
| - | 8390 | var BB1, BB2: TDIB; |
|
| - | 8391 | begin |
|
| - | 8392 | BB1 := TDIB.Create; |
|
| - | 8393 | BB1.BitCount := 24; |
|
| - | 8394 | BB1.Assign(Self); |
|
| - | 8395 | BB2 := TDIB.Create; |
|
| - | 8396 | Colorize(BB1, BB2, ForeColor, BackColor{$IFNDEF VER4UP}, False{$ENDIF}); |
|
| - | 8397 | Self.Assign(BB2); |
|
| - | 8398 | BB1.Free; |
|
| - | 8399 | BB2.Free; |
|
| - | 8400 | end; |
|
| - | 8401 | ||
| - | 8402 | { procedure for special purpose } |
|
| - | 8403 | ||
| - | 8404 | procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte); |
|
| - | 8405 | var |
|
| - | 8406 | P1, P2: PByteArray; |
|
| - | 8407 | W, H: Integer; |
|
| - | 8408 | begin |
|
| - | 8409 | P1 := ScanLine[DIB2.Height - 1]; |
|
| - | 8410 | P2 := DIB2.ScanLine[DIB2.Height - 1]; |
|
| - | 8411 | W := WidthBytes; |
|
| - | 8412 | H := Height; |
|
| - | 8413 | asm |
|
| - | 8414 | PUSH ESI |
|
| - | 8415 | PUSH EDI |
|
| - | 8416 | MOV ESI, P1 |
|
| - | 8417 | MOV EDI, P2 |
|
| - | 8418 | MOV EDX, W |
|
| - | 8419 | MOV EAX, H |
|
| - | 8420 | IMUL EDX |
|
| - | 8421 | MOV ECX, EAX |
|
| - | 8422 | @@1: |
|
| - | 8423 | MOV AL, Step |
|
| - | 8424 | MOV AH, [ESI] |
|
| - | 8425 | CMP AL, AH |
|
| - | 8426 | JA @@2 |
|
| - | 8427 | MOV AL, AH |
|
| - | 8428 | @@2: |
|
| - | 8429 | MOV [EDI], AL |
|
| - | 8430 | INC ESI |
|
| - | 8431 | INC EDI |
|
| - | 8432 | DEC ECX |
|
| - | 8433 | JNZ @@1 |
|
| - | 8434 | POP EDI |
|
| - | 8435 | POP ESI |
|
| - | 8436 | end; |
|
| - | 8437 | end; |
|
| - | 8438 | ||
| - | 8439 | procedure TDIB.DoZoom(DIB2: TDIB; ZoomRatio: Real); |
|
| - | 8440 | var |
|
| - | 8441 | P1, P2: PByteArray; |
|
| - | 8442 | W, H: Integer; |
|
| - | 8443 | x, y: Integer; |
|
| - | 8444 | xr, yr, xstep, ystep: real; |
|
| - | 8445 | xstart: real; |
|
| - | 8446 | begin |
|
| - | 8447 | W := WidthBytes; |
|
| - | 8448 | H := Height; |
|
| - | 8449 | xstart := (W - (W * ZoomRatio)) / 2; |
|
| - | 8450 | ||
| - | 8451 | xr := xstart; |
|
| - | 8452 | yr := (H - (H * ZoomRatio)) / 2; |
|
| - | 8453 | xstep := ZoomRatio; |
|
| - | 8454 | ystep := ZoomRatio; |
|
| - | 8455 | ||
| - | 8456 | for y := 1 to Height - 1 do |
|
| - | 8457 | begin |
|
| - | 8458 | P2 := DIB2.ScanLine[y]; |
|
| - | 8459 | if (yr >= 0) and (yr <= H) then |
|
| - | 8460 | begin |
|
| - | 8461 | P1 := ScanLine[Trunc(yr)]; |
|
| - | 8462 | for x := 1 to Width - 1 do |
|
| - | 8463 | begin |
|
| - | 8464 | if (xr >= 0) and (xr <= W) then |
|
| - | 8465 | begin |
|
| - | 8466 | P2[x] := P1[Trunc(xr)]; |
|
| - | 8467 | end |
|
| - | 8468 | else |
|
| - | 8469 | begin |
|
| - | 8470 | P2[x] := 0; |
|
| - | 8471 | end; |
|
| - | 8472 | xr := xr + xstep; |
|
| - | 8473 | end; |
|
| - | 8474 | end |
|
| - | 8475 | else |
|
| - | 8476 | begin |
|
| - | 8477 | for x := 1 to Width - 1 do |
|
| - | 8478 | begin |
|
| - | 8479 | P2[x] := 0; |
|
| - | 8480 | end; |
|
| - | 8481 | end; |
|
| - | 8482 | xr := xstart; |
|
| - | 8483 | yr := yr + ystep; |
|
| - | 8484 | end; |
|
| - | 8485 | end; |
|
| - | 8486 | ||
| - | 8487 | procedure TDIB.DoBlur(DIB2: TDIB); |
|
| - | 8488 | var |
|
| - | 8489 | P1, P2: PByteArray; |
|
| - | 8490 | W: Integer; |
|
| - | 8491 | x, y: Integer; |
|
| - | 8492 | begin |
|
| - | 8493 | W := WidthBytes; |
|
| - | 8494 | for y := 1 to Height - 1 do |
|
| - | 8495 | begin |
|
| - | 8496 | P1 := ScanLine[y]; |
|
| - | 8497 | P2 := DIB2.ScanLine[y]; |
|
| - | 8498 | for x := 1 to Width - 1 do |
|
| - | 8499 | begin |
|
| - | 8500 | P2[x] := (P1[x] + P1[x - 1] + P1[x + 1] + P1[x + W] + P1[x - W]) div 5; |
|
| - | 8501 | end; |
|
| - | 8502 | end; |
|
| - | 8503 | end; |
|
| - | 8504 | ||
| - | 8505 | procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte); |
|
| - | 8506 | var |
|
| - | 8507 | P1, P2: PByteArray; |
|
| - | 8508 | W, H: Integer; |
|
| - | 8509 | begin |
|
| - | 8510 | P1 := ScanLine[DIB2.Height - 1]; |
|
| - | 8511 | P2 := DIB2.ScanLine[DIB2.Height - 1]; |
|
| - | 8512 | W := WidthBytes; |
|
| - | 8513 | H := Height; |
|
| - | 8514 | asm |
|
| - | 8515 | PUSH ESI |
|
| - | 8516 | PUSH EDI |
|
| - | 8517 | MOV ESI, P1 |
|
| - | 8518 | MOV EDI, P2 |
|
| - | 8519 | MOV EDX, W |
|
| - | 8520 | MOV EAX, H |
|
| - | 8521 | IMUL EDX |
|
| - | 8522 | MOV ECX, EAX |
|
| - | 8523 | @@1: |
|
| - | 8524 | MOV AL, Step |
|
| - | 8525 | MOV AH, [ESI] |
|
| - | 8526 | CMP AL, AH |
|
| - | 8527 | JB @@2 |
|
| - | 8528 | MOV AL, AH |
|
| - | 8529 | @@2: |
|
| - | 8530 | MOV [EDI], AL |
|
| - | 8531 | INC ESI |
|
| - | 8532 | INC EDI |
|
| - | 8533 | DEC ECX |
|
| - | 8534 | JNZ @@1 |
|
| - | 8535 | POP EDI |
|
| - | 8536 | POP ESI |
|
| - | 8537 | end; |
|
| - | 8538 | end; |
|
| - | 8539 | ||
| - | 8540 | procedure TDIB.FillDIB8(Color: Byte); |
|
| - | 8541 | var |
|
| - | 8542 | P: PByteArray; |
|
| - | 8543 | W, H: Integer; |
|
| - | 8544 | begin |
|
| - | 8545 | P := ScanLine[Height - 1]; |
|
| - | 8546 | W := WidthBytes; |
|
| - | 8547 | H := Height; |
|
| - | 8548 | asm |
|
| - | 8549 | PUSH ESI |
|
| - | 8550 | MOV ESI, P |
|
| - | 8551 | MOV EDX, W |
|
| - | 8552 | MOV EAX, H |
|
| - | 8553 | IMUL EDX |
|
| - | 8554 | MOV ECX, EAX |
|
| - | 8555 | MOV AL, Color |
|
| - | 8556 | @@1: |
|
| - | 8557 | MOV [ESI], AL |
|
| - | 8558 | INC ESI |
|
| - | 8559 | DEC ECX |
|
| - | 8560 | JNZ @@1 |
|
| - | 8561 | POP ESI |
|
| - | 8562 | end; |
|
| - | 8563 | end; |
|
| - | 8564 | ||
| - | 8565 | procedure TDIB.DoRotate(DIB1: TDIB; cX, cY, Angle: Integer); |
|
| - | 8566 | type |
|
| - | 8567 | T3Byte = array[0..2] of Byte; |
|
| - | 8568 | P3ByteArray = ^T3ByteArray; |
|
| - | 8569 | T3ByteArray = array[0..32767] of T3Byte; |
|
| - | 8570 | PLongArray = ^TLongArray; |
|
| - | 8571 | TLongArray = array[0..32767] of LongInt; |
|
| - | 8572 | var |
|
| - | 8573 | p, p2: PByteArray; |
|
| - | 8574 | x, y, x2, y2, angled: Integer; |
|
| - | 8575 | cosy, siny: real; |
|
| - | 8576 | begin |
|
| - | 8577 | angled := 384 + Angle; |
|
| - | 8578 | for y := 0 to Height - 1 do |
|
| - | 8579 | begin |
|
| - | 8580 | p := DIB1.ScanLine[y]; |
|
| - | 8581 | cosy := (y - cY) * dcos(angled and $1FF); |
|
| - | 8582 | siny := (y - cY) * dsin(angled and $1FF); |
|
| - | 8583 | for x := 0 to Width - 1 do |
|
| - | 8584 | begin |
|
| - | 8585 | x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX; |
|
| - | 8586 | y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY; |
|
| - | 8587 | case bitcount of |
|
| - | 8588 | 8: |
|
| - | 8589 | begin |
|
| - | 8590 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 8591 | begin |
|
| - | 8592 | p2 := ScanLine[y2]; |
|
| - | 8593 | p[x] := p2[Width - x2]; |
|
| - | 8594 | end |
|
| - | 8595 | else |
|
| - | 8596 | begin |
|
| - | 8597 | if p[x] > 4 then |
|
| - | 8598 | p[x] := p[x] - 4 |
|
| - | 8599 | else |
|
| - | 8600 | p[x] := 0; |
|
| - | 8601 | end; |
|
| - | 8602 | end; |
|
| - | 8603 | 16: |
|
| - | 8604 | begin |
|
| - | 8605 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 8606 | begin |
|
| - | 8607 | PWordArray(p2) := ScanLine[y2]; |
|
| - | 8608 | PWordArray(p)[x] := PWordArray(p2)[Width - x2]; |
|
| - | 8609 | end |
|
| - | 8610 | else |
|
| - | 8611 | begin |
|
| - | 8612 | if PWordArray(p)[x] > 4 then |
|
| - | 8613 | PWordArray(p)[x] := PWordArray(p)[x] - 4 |
|
| - | 8614 | else |
|
| - | 8615 | PWordArray(p)[x] := 0; |
|
| - | 8616 | end; |
|
| - | 8617 | end; |
|
| - | 8618 | 24: |
|
| - | 8619 | begin |
|
| - | 8620 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 8621 | begin |
|
| - | 8622 | P3ByteArray(p2) := ScanLine[y2]; |
|
| - | 8623 | P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2]; |
|
| - | 8624 | end |
|
| - | 8625 | else |
|
| - | 8626 | begin |
|
| - | 8627 | if P3ByteArray(p)[x][0] > 4 then |
|
| - | 8628 | P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 4 |
|
| - | 8629 | else if P3ByteArray(p)[x][1] > 4 then |
|
| - | 8630 | P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 4 |
|
| - | 8631 | else if P3ByteArray(p)[x][2] > 4 then |
|
| - | 8632 | P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 4 |
|
| - | 8633 | else |
|
| - | 8634 | begin |
|
| - | 8635 | P3ByteArray(p)[x][0] := 0; |
|
| - | 8636 | P3ByteArray(p)[x][1] := 0; |
|
| - | 8637 | P3ByteArray(p)[x][2] := 0; |
|
| - | 8638 | end; |
|
| - | 8639 | end; |
|
| - | 8640 | end; |
|
| - | 8641 | 32: begin |
|
| - | 8642 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 8643 | begin |
|
| - | 8644 | plongarray(p2) := ScanLine[y2]; |
|
| - | 8645 | plongarray(p)[x] := plongarray(p2)[Width - x2]; |
|
| - | 8646 | end |
|
| - | 8647 | else |
|
| - | 8648 | begin |
|
| - | 8649 | if plongarray(p)[x] > 4 then |
|
| - | 8650 | plongarray(p)[x] := plongarray(p)[x] - 4 |
|
| - | 8651 | else |
|
| - | 8652 | plongarray(p)[x] := 0; |
|
| - | 8653 | end; |
|
| - | 8654 | end; |
|
| - | 8655 | end |
|
| - | 8656 | end; |
|
| - | 8657 | end; |
|
| - | 8658 | end; |
|
| - | 8659 | ||
| - | 8660 | function TDIB.Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean; |
|
| - | 8661 | type |
|
| - | 8662 | T3Byte = array[0..2] of Byte; |
|
| - | 8663 | P3ByteArray = ^T3ByteArray; |
|
| - | 8664 | T3ByteArray = array[0..32767] of T3Byte; |
|
| - | 8665 | PLongArray = ^TLongArray; |
|
| - | 8666 | TLongArray = array[0..32767] of LongInt; |
|
| - | 8667 | function ColorToRGBTriple(const Color: TColor): TRGBTriple; |
|
| - | 8668 | begin |
|
| - | 8669 | with RESULT do |
|
| - | 8670 | begin |
|
| - | 8671 | rgbtRed := GetRValue(Color); |
|
| - | 8672 | rgbtGreen := GetGValue(Color); |
|
| - | 8673 | rgbtBlue := GetBValue(Color) |
|
| - | 8674 | end |
|
| - | 8675 | end {ColorToRGBTriple}; |
|
| - | 8676 | ||
| - | 8677 | function TestQuad(T: T3Byte; Color: Integer): Boolean; |
|
| - | 8678 | begin |
|
| - | 8679 | Result := (T[0] > GetRValue(Color)) and |
|
| - | 8680 | (T[1] > GetGValue(Color)) and |
|
| - | 8681 | (T[2] > GetBValue(Color)) |
|
| - | 8682 | end; |
|
| - | 8683 | var |
|
| - | 8684 | p0, p, p2: PByteArray; |
|
| - | 8685 | x, y, c: Integer; |
|
| - | 8686 | z: Integer; |
|
| - | 8687 | begin |
|
| - | 8688 | if SprayInit then |
|
| - | 8689 | begin |
|
| - | 8690 | DIB.Assign(Self); |
|
| - | 8691 | { Spray seeds } |
|
| - | 8692 | for c := 0 to AmountSpray do |
|
| - | 8693 | begin |
|
| - | 8694 | DIB.Pixels[Random(Width - 1), Random(Height - 1)] := 0; |
|
| - | 8695 | end; |
|
| - | 8696 | end; |
|
| - | 8697 | Result := True; {all is black} |
|
| - | 8698 | for y := 0 to DIB.Height - 1 do |
|
| - | 8699 | begin |
|
| - | 8700 | p := DIB.ScanLine[y]; |
|
| - | 8701 | for x := 0 to DIB.Width - 1 do |
|
| - | 8702 | begin |
|
| - | 8703 | case bitcount of |
|
| - | 8704 | 8: |
|
| - | 8705 | begin |
|
| - | 8706 | if p[x] < 16 then |
|
| - | 8707 | begin |
|
| - | 8708 | if p[x] > 0 then Result := False; |
|
| - | 8709 | if y > 0 then |
|
| - | 8710 | begin |
|
| - | 8711 | p0 := DIB.ScanLine[y - 1]; |
|
| - | 8712 | if p0[x] > 4 then |
|
| - | 8713 | p0[x] := p0[x] - 4 |
|
| - | 8714 | else |
|
| - | 8715 | p0[x] := 0; |
|
| - | 8716 | if x > 0 then |
|
| - | 8717 | if p0[x - 1] > 2 then |
|
| - | 8718 | p0[x - 1] := p0[x - 1] - 2 |
|
| - | 8719 | else |
|
| - | 8720 | p0[x - 1] := 0; |
|
| - | 8721 | if x < (DIB.Width - 1) then |
|
| - | 8722 | if p0[x + 1] > 2 then |
|
| - | 8723 | p0[x + 1] := p0[x + 1] - 2 |
|
| - | 8724 | else |
|
| - | 8725 | p0[x + 1] := 0; |
|
| - | 8726 | end; |
|
| - | 8727 | if y < (DIB.Height - 1) then |
|
| - | 8728 | begin |
|
| - | 8729 | p2 := DIB.ScanLine[y + 1]; |
|
| - | 8730 | if p2[x] > 4 then |
|
| - | 8731 | p2[x] := p2[x] - 4 |
|
| - | 8732 | else |
|
| - | 8733 | p2[x] := 0; |
|
| - | 8734 | if x > 0 then |
|
| - | 8735 | if p2[x - 1] > 2 then |
|
| - | 8736 | p2[x - 1] := p2[x - 1] - 2 |
|
| - | 8737 | else |
|
| - | 8738 | p2[x - 1] := 0; |
|
| - | 8739 | if x < (DIB.Width - 1) then |
|
| - | 8740 | if p2[x + 1] > 2 then |
|
| - | 8741 | p2[x + 1] := p2[x + 1] - 2 |
|
| - | 8742 | else |
|
| - | 8743 | p2[x + 1] := 0; |
|
| - | 8744 | end; |
|
| - | 8745 | if p[x] > 8 then |
|
| - | 8746 | p[x] := p[x] - 8 |
|
| - | 8747 | else |
|
| - | 8748 | p[x] := 0; |
|
| - | 8749 | if x > 0 then |
|
| - | 8750 | if p[x - 1] > 4 then |
|
| - | 8751 | p[x - 1] := p[x - 1] - 4 |
|
| - | 8752 | else |
|
| - | 8753 | p[x - 1] := 0; |
|
| - | 8754 | if x < (DIB.Width - 1) then |
|
| - | 8755 | if p[x + 1] > 4 then |
|
| - | 8756 | p[x + 1] := p[x + 1] - 4 |
|
| - | 8757 | else |
|
| - | 8758 | p[x + 1] := 0; |
|
| - | 8759 | end; |
|
| - | 8760 | end; |
|
| - | 8761 | 16: |
|
| - | 8762 | begin |
|
| - | 8763 | if pwordarray(p)[x] < 16 then |
|
| - | 8764 | begin |
|
| - | 8765 | if pwordarray(p)[x] > 0 then Result := False; |
|
| - | 8766 | if y > 0 then |
|
| - | 8767 | begin |
|
| - | 8768 | pwordarray(p0) := DIB.ScanLine[y - 1]; |
|
| - | 8769 | if pwordarray(p0)[x] > 4 then |
|
| - | 8770 | pwordarray(p0)[x] := pwordarray(p0)[x] - 4 |
|
| - | 8771 | else |
|
| - | 8772 | pwordarray(p0)[x] := 0; |
|
| - | 8773 | if x > 0 then |
|
| - | 8774 | if pwordarray(p0)[x - 1] > 2 then |
|
| - | 8775 | pwordarray(p0)[x - 1] := pwordarray(p0)[x - 1] - 2 |
|
| - | 8776 | else |
|
| - | 8777 | pwordarray(p0)[x - 1] := 0; |
|
| - | 8778 | if x < (DIB.Width - 1) then |
|
| - | 8779 | if pwordarray(p0)[x + 1] > 2 then |
|
| - | 8780 | pwordarray(p0)[x + 1] := pwordarray(p0)[x + 1] - 2 |
|
| - | 8781 | else |
|
| - | 8782 | pwordarray(p0)[x + 1] := 0; |
|
| - | 8783 | end; |
|
| - | 8784 | if y < (DIB.Height - 1) then |
|
| - | 8785 | begin |
|
| - | 8786 | pwordarray(p2) := DIB.ScanLine[y + 1]; |
|
| - | 8787 | if pwordarray(p2)[x] > 4 then |
|
| - | 8788 | pwordarray(p2)[x] := pwordarray(p2)[x] - 4 |
|
| - | 8789 | else |
|
| - | 8790 | pwordarray(p2)[x] := 0; |
|
| - | 8791 | if x > 0 then |
|
| - | 8792 | if pwordarray(p2)[x - 1] > 2 then |
|
| - | 8793 | pwordarray(p2)[x - 1] := pwordarray(p2)[x - 1] - 2 |
|
| - | 8794 | else |
|
| - | 8795 | pwordarray(p2)[x - 1] := 0; |
|
| - | 8796 | if x < (DIB.Width - 1) then |
|
| - | 8797 | if pwordarray(p2)[x + 1] > 2 then |
|
| - | 8798 | pwordarray(p2)[x + 1] := pwordarray(p2)[x + 1] - 2 |
|
| - | 8799 | else |
|
| - | 8800 | pwordarray(p2)[x + 1] := 0; |
|
| - | 8801 | end; |
|
| - | 8802 | if pwordarray(p)[x] > 8 then |
|
| - | 8803 | pwordarray(p)[x] := pwordarray(p)[x] - 8 |
|
| - | 8804 | else |
|
| - | 8805 | pwordarray(p)[x] := 0; |
|
| - | 8806 | if x > 0 then |
|
| - | 8807 | if pwordarray(p)[x - 1] > 4 then |
|
| - | 8808 | pwordarray(p)[x - 1] := pwordarray(p)[x - 1] - 4 |
|
| - | 8809 | else |
|
| - | 8810 | pwordarray(p)[x - 1] := 0; |
|
| - | 8811 | if x < (DIB.Width - 1) then |
|
| - | 8812 | if pwordarray(p)[x + 1] > 4 then |
|
| - | 8813 | pwordarray(p)[x + 1] := pwordarray(p)[x + 1] - 4 |
|
| - | 8814 | else |
|
| - | 8815 | pwordarray(p)[x + 1] := 0; |
|
| - | 8816 | end; |
|
| - | 8817 | end; |
|
| - | 8818 | 24: |
|
| - | 8819 | begin |
|
| - | 8820 | if not TestQuad(P3ByteArray(p)[x], 16) then |
|
| - | 8821 | begin |
|
| - | 8822 | if TestQuad(P3ByteArray(p)[x], 0) then Result := False; |
|
| - | 8823 | if y > 0 then |
|
| - | 8824 | begin |
|
| - | 8825 | P3ByteArray(p0) := DIB.ScanLine[y - 1]; |
|
| - | 8826 | if TestQuad(P3ByteArray(p0)[x], 4) then |
|
| - | 8827 | begin |
|
| - | 8828 | for z := 0 to 2 do |
|
| - | 8829 | if P3ByteArray(p0)[x][z] > 4 then |
|
| - | 8830 | P3ByteArray(p0)[x][z] := P3ByteArray(p0)[x][z] - 4 |
|
| - | 8831 | end |
|
| - | 8832 | else |
|
| - | 8833 | for z := 0 to 2 do |
|
| - | 8834 | P3ByteArray(p0)[x][z] := 0; |
|
| - | 8835 | if x > 0 then |
|
| - | 8836 | if TestQuad(P3ByteArray(p0)[x - 1], 2) then |
|
| - | 8837 | begin |
|
| - | 8838 | for z := 0 to 2 do |
|
| - | 8839 | if P3ByteArray(p0)[x - 1][z] > 2 then |
|
| - | 8840 | P3ByteArray(p0)[x - 1][z] := P3ByteArray(p0)[x - 1][z] - 2 |
|
| - | 8841 | end |
|
| - | 8842 | else |
|
| - | 8843 | for z := 0 to 2 do |
|
| - | 8844 | P3ByteArray(p0)[x - 1][z] := 0; |
|
| - | 8845 | if x < (DIB.Width - 1) then |
|
| - | 8846 | if TestQuad(P3ByteArray(p0)[x + 1], 2) then |
|
| - | 8847 | begin |
|
| - | 8848 | for z := 0 to 2 do |
|
| - | 8849 | if P3ByteArray(p0)[x + 1][z] > 2 then |
|
| - | 8850 | P3ByteArray(p0)[x + 1][z] := P3ByteArray(p0)[x + 1][z] - 2 |
|
| - | 8851 | end |
|
| - | 8852 | else |
|
| - | 8853 | for z := 0 to 2 do |
|
| - | 8854 | P3ByteArray(p0)[x + 1][z] := 0; |
|
| - | 8855 | end; |
|
| - | 8856 | if y < (DIB.Height - 1) then |
|
| - | 8857 | begin |
|
| - | 8858 | P3ByteArray(p2) := DIB.ScanLine[y + 1]; |
|
| - | 8859 | if TestQuad(P3ByteArray(p2)[x], 4) then |
|
| - | 8860 | begin |
|
| - | 8861 | for z := 0 to 2 do |
|
| - | 8862 | if P3ByteArray(p2)[x][z] > 4 then |
|
| - | 8863 | P3ByteArray(p2)[x][z] := P3ByteArray(p2)[x][z] - 4 |
|
| - | 8864 | end |
|
| - | 8865 | else |
|
| - | 8866 | for z := 0 to 2 do |
|
| - | 8867 | P3ByteArray(p2)[x][z] := 0; |
|
| - | 8868 | if x > 0 then |
|
| - | 8869 | if TestQuad(P3ByteArray(p2)[x - 1], 2) then |
|
| - | 8870 | begin |
|
| - | 8871 | for z := 0 to 2 do |
|
| - | 8872 | if P3ByteArray(p2)[x - 1][z] > 2 then |
|
| - | 8873 | P3ByteArray(p2)[x - 1][z] := P3ByteArray(p2)[x - 1][z] - 2 |
|
| - | 8874 | end |
|
| - | 8875 | else |
|
| - | 8876 | for z := 0 to 2 do |
|
| - | 8877 | P3ByteArray(p2)[x - 1][z] := 0; |
|
| - | 8878 | if x < (DIB.Width - 1) then |
|
| - | 8879 | if TestQuad(P3ByteArray(p2)[x + 1], 2) then |
|
| - | 8880 | begin |
|
| - | 8881 | for z := 0 to 2 do |
|
| - | 8882 | if P3ByteArray(p2)[x + 1][z] > 2 then |
|
| - | 8883 | P3ByteArray(p2)[x + 1][z] := P3ByteArray(p2)[x + 1][z] - 2 |
|
| - | 8884 | end |
|
| - | 8885 | else |
|
| - | 8886 | for z := 0 to 2 do |
|
| - | 8887 | P3ByteArray(p2)[x + 1][z] := 0; |
|
| - | 8888 | end; |
|
| - | 8889 | if TestQuad(P3ByteArray(p)[x], 8) then |
|
| - | 8890 | begin |
|
| - | 8891 | for z := 0 to 2 do |
|
| - | 8892 | if P3ByteArray(p)[x][z] > 8 then |
|
| - | 8893 | P3ByteArray(p)[x][z] := P3ByteArray(p)[x][z] - 8 |
|
| - | 8894 | end |
|
| - | 8895 | else |
|
| - | 8896 | for z := 0 to 2 do |
|
| - | 8897 | P3ByteArray(p)[x][z] := 0; |
|
| - | 8898 | if x > 0 then |
|
| - | 8899 | if TestQuad(P3ByteArray(p)[x - 1], 4) then |
|
| - | 8900 | begin |
|
| - | 8901 | for z := 0 to 2 do |
|
| - | 8902 | if P3ByteArray(p)[x - 1][z] > 4 then |
|
| - | 8903 | P3ByteArray(p)[x - 1][z] := P3ByteArray(p)[x - 1][z] - 4 |
|
| - | 8904 | end |
|
| - | 8905 | else |
|
| - | 8906 | for z := 0 to 2 do |
|
| - | 8907 | P3ByteArray(p)[x - 1][z] := 0; |
|
| - | 8908 | if x < (DIB.Width - 1) then |
|
| - | 8909 | if TestQuad(P3ByteArray(p)[x + 1], 4) then |
|
| - | 8910 | begin |
|
| - | 8911 | for z := 0 to 2 do |
|
| - | 8912 | if P3ByteArray(p)[x + 1][z] > 4 then |
|
| - | 8913 | P3ByteArray(p)[x + 1][z] := P3ByteArray(p)[x + 1][z] - 4 |
|
| - | 8914 | end |
|
| - | 8915 | else |
|
| - | 8916 | for z := 0 to 2 do |
|
| - | 8917 | P3ByteArray(p)[x + 1][z] := 0; |
|
| - | 8918 | end; |
|
| - | 8919 | end; |
|
| - | 8920 | 32: |
|
| - | 8921 | begin |
|
| - | 8922 | if plongarray(p)[x] < 16 then |
|
| - | 8923 | begin |
|
| - | 8924 | if plongarray(p)[x] > 0 then Result := False; |
|
| - | 8925 | if y > 0 then |
|
| - | 8926 | begin |
|
| - | 8927 | plongarray(p0) := DIB.ScanLine[y - 1]; |
|
| - | 8928 | if plongarray(p0)[x] > 4 then |
|
| - | 8929 | plongarray(p0)[x] := plongarray(p0)[x] - 4 |
|
| - | 8930 | else |
|
| - | 8931 | plongarray(p0)[x] := 0; |
|
| - | 8932 | if x > 0 then |
|
| - | 8933 | if plongarray(p0)[x - 1] > 2 then |
|
| - | 8934 | plongarray(p0)[x - 1] := plongarray(p0)[x - 1] - 2 |
|
| - | 8935 | else |
|
| - | 8936 | plongarray(p0)[x - 1] := 0; |
|
| - | 8937 | if x < (DIB.Width - 1) then |
|
| - | 8938 | if plongarray(p0)[x + 1] > 2 then |
|
| - | 8939 | plongarray(p0)[x + 1] := plongarray(p0)[x + 1] - 2 |
|
| - | 8940 | else |
|
| - | 8941 | plongarray(p0)[x + 1] := 0; |
|
| - | 8942 | end; |
|
| - | 8943 | if y < (DIB.Height - 1) then |
|
| - | 8944 | begin |
|
| - | 8945 | plongarray(p2) := DIB.ScanLine[y + 1]; |
|
| - | 8946 | if plongarray(p2)[x] > 4 then |
|
| - | 8947 | plongarray(p2)[x] := plongarray(p2)[x] - 4 |
|
| - | 8948 | else |
|
| - | 8949 | plongarray(p2)[x] := 0; |
|
| - | 8950 | if x > 0 then |
|
| - | 8951 | if plongarray(p2)[x - 1] > 2 then |
|
| - | 8952 | plongarray(p2)[x - 1] := plongarray(p2)[x - 1] - 2 |
|
| - | 8953 | else |
|
| - | 8954 | plongarray(p2)[x - 1] := 0; |
|
| - | 8955 | if x < (DIB.Width - 1) then |
|
| - | 8956 | if plongarray(p2)[x + 1] > 2 then |
|
| - | 8957 | plongarray(p2)[x + 1] := plongarray(p2)[x + 1] - 2 |
|
| - | 8958 | else |
|
| - | 8959 | plongarray(p2)[x + 1] := 0; |
|
| - | 8960 | end; |
|
| - | 8961 | if plongarray(p)[x] > 8 then |
|
| - | 8962 | plongarray(p)[x] := plongarray(p)[x] - 8 |
|
| - | 8963 | else |
|
| - | 8964 | plongarray(p)[x] := 0; |
|
| - | 8965 | if x > 0 then |
|
| - | 8966 | if plongarray(p)[x - 1] > 4 then |
|
| - | 8967 | plongarray(p)[x - 1] := plongarray(p)[x - 1] - 4 |
|
| - | 8968 | else |
|
| - | 8969 | plongarray(p)[x - 1] := 0; |
|
| - | 8970 | if x < (DIB.Width - 1) then |
|
| - | 8971 | if plongarray(p)[x + 1] > 4 then |
|
| - | 8972 | plongarray(p)[x + 1] := plongarray(p)[x + 1] - 4 |
|
| - | 8973 | else |
|
| - | 8974 | plongarray(p)[x + 1] := 0; |
|
| - | 8975 | end; |
|
| - | 8976 | end; |
|
| - | 8977 | end {case}; |
|
| - | 8978 | end; |
|
| - | 8979 | end; |
|
| - | 8980 | end; |
|
| - | 8981 | ||
| - | 8982 | procedure TDIB.Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real); |
|
| - | 8983 | type |
|
| - | 8984 | T3Byte = array[0..2] of Byte; |
|
| - | 8985 | P3ByteArray = ^T3ByteArray; |
|
| - | 8986 | T3ByteArray = array[0..32767] of T3Byte; |
|
| - | 8987 | PLongArray = ^TLongArray; |
|
| - | 8988 | TLongArray = array[0..32767] of LongInt; |
|
| - | 8989 | var |
|
| - | 8990 | p, p2: PByteArray; |
|
| - | 8991 | x, y, x2, y2, angled, ysqr: Integer; |
|
| - | 8992 | actdist, dist, cosy, siny: real; |
|
| - | 8993 | begin |
|
| - | 8994 | dist := Factor * sqrt(sqr(cX) + sqr(cY)); |
|
| - | 8995 | for y := 0 to DIB1.Height - 1 do |
|
| - | 8996 | begin |
|
| - | 8997 | p := DIB1.ScanLine[y]; |
|
| - | 8998 | ysqr := sqr(y - cY); |
|
| - | 8999 | for x := 0 to (DIB1.Width) - 1 do |
|
| - | 9000 | begin |
|
| - | 9001 | actdist := (sqrt((sqr(x - cX) + ysqr)) / dist); |
|
| - | 9002 | if dt = dtSlow then |
|
| - | 9003 | actdist := dsin((Trunc(actdist * 1024)) and $1FF); |
|
| - | 9004 | angled := 384 + Trunc((actdist) * Angle); |
|
| - | 9005 | ||
| - | 9006 | cosy := (y - cY) * dcos(angled and $1FF); |
|
| - | 9007 | siny := (y - cY) * dsin(angled and $1FF); |
|
| - | 9008 | ||
| - | 9009 | x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX; |
|
| - | 9010 | y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY; |
|
| - | 9011 | case bitcount of |
|
| - | 9012 | 8: |
|
| - | 9013 | begin |
|
| - | 9014 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 9015 | begin |
|
| - | 9016 | p2 := ScanLine[y2]; |
|
| - | 9017 | p[x] := p2[Width - x2]; |
|
| - | 9018 | end |
|
| - | 9019 | else |
|
| - | 9020 | begin |
|
| - | 9021 | if p[x] > 2 then |
|
| - | 9022 | p[x] := p[x] - 2 |
|
| - | 9023 | else |
|
| - | 9024 | p[x] := 0; |
|
| - | 9025 | end; |
|
| - | 9026 | end; |
|
| - | 9027 | 16: |
|
| - | 9028 | begin |
|
| - | 9029 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 9030 | begin |
|
| - | 9031 | pwordarray(p2) := ScanLine[y2]; |
|
| - | 9032 | pwordarray(p)[x] := pwordarray(p2)[Width - x2]; |
|
| - | 9033 | end |
|
| - | 9034 | else |
|
| - | 9035 | begin |
|
| - | 9036 | if pwordarray(p)[x] > 2 then |
|
| - | 9037 | pwordarray(p)[x] := pwordarray(p)[x] - 2 |
|
| - | 9038 | else |
|
| - | 9039 | pwordarray(p)[x] := 0; |
|
| - | 9040 | end; |
|
| - | 9041 | end; |
|
| - | 9042 | 24: |
|
| - | 9043 | begin |
|
| - | 9044 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 9045 | begin |
|
| - | 9046 | P3ByteArray(p2) := ScanLine[y2]; |
|
| - | 9047 | P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2]; |
|
| - | 9048 | end |
|
| - | 9049 | else |
|
| - | 9050 | begin |
|
| - | 9051 | if P3ByteArray(p)[x][0] > 2 then |
|
| - | 9052 | P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 2 |
|
| - | 9053 | else if P3ByteArray(p)[x][1] > 2 then |
|
| - | 9054 | P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 2 |
|
| - | 9055 | else if P3ByteArray(p)[x][2] > 2 then |
|
| - | 9056 | P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 2 |
|
| - | 9057 | else |
|
| - | 9058 | begin |
|
| - | 9059 | P3ByteArray(p)[x][0] := 0; |
|
| - | 9060 | P3ByteArray(p)[x][1] := 0; |
|
| - | 9061 | P3ByteArray(p)[x][2] := 0; |
|
| - | 9062 | end; |
|
| - | 9063 | end; |
|
| - | 9064 | end; |
|
| - | 9065 | 32: |
|
| - | 9066 | begin |
|
| - | 9067 | if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then |
|
| - | 9068 | begin |
|
| - | 9069 | plongarray(p2) := ScanLine[y2]; |
|
| - | 9070 | plongarray(p)[x] := plongarray(p2)[Width - x2]; |
|
| - | 9071 | end |
|
| - | 9072 | else |
|
| - | 9073 | begin |
|
| - | 9074 | if p[x] > 2 then |
|
| - | 9075 | plongarray(p)[x] := plongarray(p)[x] - 2 |
|
| - | 9076 | else |
|
| - | 9077 | plongarray(p)[x] := 0; |
|
| - | 9078 | end; |
|
| - | 9079 | end; |
|
| - | 9080 | end {case} |
|
| - | 9081 | end; |
|
| - | 9082 | end; |
|
| - | 9083 | end; |
|
| - | 9084 | ||
| - | 9085 | procedure TDIB.AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); |
|
| - | 9086 | //anti-aliased line using the Wu algorithm by Peter Bone |
|
| - | 9087 | var |
|
| - | 9088 | dX, dY, X, Y, start, finish: Integer; |
|
| - | 9089 | LM, LR: Integer; |
|
| - | 9090 | dxi, dyi, dydxi: Integer; |
|
| - | 9091 | P: PLines; |
|
| - | 9092 | R, G, B: byte; |
|
| - | 9093 | begin |
|
| - | 9094 | R := GetRValue(Color); |
|
| - | 9095 | G := GetGValue(Color); |
|
| - | 9096 | B := GetBValue(Color); |
|
| - | 9097 | dX := abs(x2 - x1); // Calculate deltax and deltay for initialisation |
|
| - | 9098 | dY := abs(y2 - y1); |
|
| - | 9099 | if (dX = 0) or (dY = 0) then |
|
| - | 9100 | begin |
|
| - | 9101 | Canvas.Pen.Color := (B shl 16) + (G shl 8) + R; |
|
| - | 9102 | Canvas.MoveTo(x1, y1); |
|
| - | 9103 | Canvas.LineTo(x2, y2); |
|
| - | 9104 | exit; |
|
| - | 9105 | end; |
|
| - | 9106 | if dX > dY then |
|
| - | 9107 | begin // horizontal or vertical |
|
| - | 9108 | if y2 > y1 then // determine rise and run |
|
| - | 9109 | dydxi := -dY shl 16 div dX |
|
| - | 9110 | else |
|
| - | 9111 | dydxi := dY shl 16 div dX; |
|
| - | 9112 | if x2 < x1 then |
|
| - | 9113 | begin |
|
| - | 9114 | start := x2; // right to left |
|
| - | 9115 | finish := x1; |
|
| - | 9116 | dyi := y2 shl 16; |
|
| - | 9117 | end |
|
| - | 9118 | else |
|
| - | 9119 | begin |
|
| - | 9120 | start := x1; // left to right |
|
| - | 9121 | finish := x2; |
|
| - | 9122 | dyi := y1 shl 16; |
|
| - | 9123 | dydxi := -dydxi; // inverse slope |
|
| - | 9124 | end; |
|
| - | 9125 | if finish >= Width then finish := Width - 1; |
|
| - | 9126 | for X := start to finish do |
|
| - | 9127 | begin |
|
| - | 9128 | Y := dyi shr 16; |
|
| - | 9129 | if (X < 0) or (Y < 0) or (Y > Height - 2) then |
|
| - | 9130 | begin |
|
| - | 9131 | Inc(dyi, dydxi); |
|
| - | 9132 | Continue; |
|
| - | 9133 | end; |
|
| - | 9134 | LM := dyi - Y shl 16; // fractional part of dyi - in fixed-point |
|
| - | 9135 | LR := 65536 - LM; |
|
| - | 9136 | P := Scanline[Y]; |
|
| - | 9137 | P^[X].B := (B * LR + P^[X].B * LM) shr 16; |
|
| - | 9138 | P^[X].G := (G * LR + P^[X].G * LM) shr 16; |
|
| - | 9139 | P^[X].R := (R * LR + P^[X].R * LM) shr 16; |
|
| - | 9140 | //Inc(Y); |
|
| - | 9141 | P^[X].B := (B * LM + P^[X].B * LR) shr 16; |
|
| - | 9142 | P^[X].G := (G * LM + P^[X].G * LR) shr 16; |
|
| - | 9143 | P^[X].R := (R * LM + P^[X].R * LR) shr 16; |
|
| - | 9144 | Inc(dyi, dydxi); // next point |
|
| - | 9145 | end; |
|
| - | 9146 | end |
|
| - | 9147 | else |
|
| - | 9148 | begin |
|
| - | 9149 | if x2 > x1 then // determine rise and run |
|
| - | 9150 | dydxi := -dX shl 16 div dY |
|
| - | 9151 | else |
|
| - | 9152 | dydxi := dX shl 16 div dY; |
|
| - | 9153 | if y2 < y1 then |
|
| - | 9154 | begin |
|
| - | 9155 | start := y2; // right to left |
|
| - | 9156 | finish := y1; |
|
| - | 9157 | dxi := x2 shl 16; |
|
| - | 9158 | end |
|
| - | 9159 | else |
|
| - | 9160 | begin |
|
| - | 9161 | start := y1; // left to right |
|
| - | 9162 | finish := y2; |
|
| - | 9163 | dxi := x1 shl 16; |
|
| - | 9164 | dydxi := -dydxi; // inverse slope |
|
| - | 9165 | end; |
|
| - | 9166 | if finish >= Height then finish := Height - 1; |
|
| - | 9167 | for Y := start to finish do |
|
| - | 9168 | begin |
|
| - | 9169 | X := dxi shr 16; |
|
| - | 9170 | if (Y < 0) or (X < 0) or (X > Width - 2) then |
|
| - | 9171 | begin |
|
| - | 9172 | Inc(dxi, dydxi); |
|
| - | 9173 | Continue; |
|
| - | 9174 | end; |
|
| - | 9175 | LM := dxi - X shl 16; |
|
| - | 9176 | LR := 65536 - LM; |
|
| - | 9177 | P := Scanline[Y]; |
|
| - | 9178 | P^[X].B := (B * LR + P^[X].B * LM) shr 16; |
|
| - | 9179 | P^[X].G := (G * LR + P^[X].G * LM) shr 16; |
|
| - | 9180 | P^[X].R := (R * LR + P^[X].R * LM) shr 16; |
|
| - | 9181 | Inc(X); |
|
| - | 9182 | P^[X].B := (B * LM + P^[X].B * LR) shr 16; |
|
| - | 9183 | P^[X].G := (G * LM + P^[X].G * LR) shr 16; |
|
| - | 9184 | P^[X].R := (R * LM + P^[X].R * LR) shr 16; |
|
| - | 9185 | Inc(dxi, dydxi); // next point |
|
| - | 9186 | end; |
|
| - | 9187 | end; |
|
| - | 9188 | end; |
|
| - | 9189 | ||
| - | 9190 | function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue, |
|
| - | 9191 | FromPoint, ToPoint: Extended): TColor; |
|
| - | 9192 | var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte; |
|
| - | 9193 | function CalcColorBytes(fb1, fb2: Byte): Byte; |
|
| - | 9194 | begin |
|
| - | 9195 | result := fb1; |
|
| - | 9196 | if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1)); |
|
| - | 9197 | if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2)); |
|
| - | 9198 | end; |
|
| - | 9199 | begin |
|
| - | 9200 | if Pointvalue <= FromPoint then |
|
| - | 9201 | begin |
|
| - | 9202 | result := StartColor; |
|
| - | 9203 | exit; |
|
| - | 9204 | end; |
|
| - | 9205 | if Pointvalue >= ToPoint then |
|
| - | 9206 | begin |
|
| - | 9207 | result := EndColor; |
|
| - | 9208 | exit; |
|
| - | 9209 | end; |
|
| - | 9210 | F := (Pointvalue - FromPoint) / (ToPoint - FromPoint); |
|
| - | 9211 | asm |
|
| - | 9212 | mov EAX, Startcolor |
|
| - | 9213 | cmp EAX, EndColor |
|
| - | 9214 | je @@exit //when equal then exit |
|
| - | 9215 | mov r1, AL |
|
| - | 9216 | shr EAX,8 |
|
| - | 9217 | mov g1, AL |
|
| - | 9218 | shr EAX,8 |
|
| - | 9219 | mov b1, AL |
|
| - | 9220 | mov EAX, Endcolor |
|
| - | 9221 | mov r2, AL |
|
| - | 9222 | shr EAX,8 |
|
| - | 9223 | mov g2, AL |
|
| - | 9224 | shr EAX,8 |
|
| - | 9225 | mov b2, AL |
|
| - | 9226 | push ebp |
|
| - | 9227 | mov AL, r1 |
|
| - | 9228 | mov DL, r2 |
|
| - | 9229 | call CalcColorBytes |
|
| - | 9230 | pop ECX |
|
| - | 9231 | push EBP |
|
| - | 9232 | Mov r3, AL |
|
| - | 9233 | mov DL, g2 |
|
| - | 9234 | mov AL, g1 |
|
| - | 9235 | call CalcColorBytes |
|
| - | 9236 | pop ECX |
|
| - | 9237 | push EBP |
|
| - | 9238 | mov g3, Al |
|
| - | 9239 | mov DL, B2 |
|
| - | 9240 | mov Al, B1 |
|
| - | 9241 | call CalcColorBytes |
|
| - | 9242 | pop ECX |
|
| - | 9243 | mov b3, AL |
|
| - | 9244 | XOR EAX,EAX |
|
| - | 9245 | mov AL, B3 |
|
| - | 9246 | shl EAX,8 |
|
| - | 9247 | mov AL, G3 |
|
| - | 9248 | shl EAX,8 |
|
| - | 9249 | mov AL, R3 |
|
| - | 9250 | @@Exit: |
|
| - | 9251 | mov @result, EAX |
|
| - | 9252 | end; |
|
| - | 9253 | end; |
|
| - | 9254 | ||
| - | 9255 | procedure TDIB.ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle; |
|
| - | 9256 | iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; iRadius: Word); |
|
| - | 9257 | var |
|
| - | 9258 | tempColor: TColor; |
|
| - | 9259 | const |
|
| - | 9260 | WavelengthMinimum = 380; |
|
| - | 9261 | WavelengthMaximum = 780; |
|
| - | 9262 | ||
| - | 9263 | procedure SetColor(Color: TColor); |
|
| - | 9264 | begin |
|
| - | 9265 | Canvas.Pen.Color := Color; |
|
| - | 9266 | Canvas.Brush.Color := Color; |
|
| - | 9267 | tempColor := Color |
|
| - | 9268 | end {SetColor}; |
|
| - | 9269 | ||
| - | 9270 | function WL2RGB(const Wavelength: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9271 | const |
|
| - | 9272 | Gamma = 0.80; |
|
| - | 9273 | IntensityMax = 255; |
|
| - | 9274 | var |
|
| - | 9275 | Red, Blue, Green, Factor: Double; |
|
| - | 9276 | ||
| - | 9277 | function Adjust(const Color, Factor: Double): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9278 | begin |
|
| - | 9279 | if Color = 0.0 then Result := 0 |
|
| - | 9280 | else Result := Round(IntensityMax * Power(Color * Factor, Gamma)) |
|
| - | 9281 | end {Adjust}; |
|
| - | 9282 | begin |
|
| - | 9283 | case Trunc(Wavelength) of |
|
| - | 9284 | 380..439: |
|
| - | 9285 | begin |
|
| - | 9286 | Red := -(Wavelength - 440) / (440 - 380); |
|
| - | 9287 | Green := 0.0; |
|
| - | 9288 | Blue := 1.0 |
|
| - | 9289 | end; |
|
| - | 9290 | 440..489: |
|
| - | 9291 | begin |
|
| - | 9292 | Red := 0.0; |
|
| - | 9293 | Green := (Wavelength - 440) / (490 - 440); |
|
| - | 9294 | Blue := 1.0 |
|
| - | 9295 | end; |
|
| - | 9296 | 490..509: |
|
| - | 9297 | begin |
|
| - | 9298 | Red := 0.0; |
|
| - | 9299 | Green := 1.0; |
|
| - | 9300 | Blue := -(Wavelength - 510) / (510 - 490) |
|
| - | 9301 | end; |
|
| - | 9302 | 510..579: |
|
| - | 9303 | begin |
|
| - | 9304 | Red := (Wavelength - 510) / (580 - 510); |
|
| - | 9305 | Green := 1.0; |
|
| - | 9306 | Blue := 0.0 |
|
| - | 9307 | end; |
|
| - | 9308 | 580..644: |
|
| - | 9309 | begin |
|
| - | 9310 | Red := 1.0; |
|
| - | 9311 | Green := -(Wavelength - 645) / (645 - 580); |
|
| - | 9312 | Blue := 0.0 |
|
| - | 9313 | end; |
|
| - | 9314 | 645..780: |
|
| - | 9315 | begin |
|
| - | 9316 | Red := 1.0; |
|
| - | 9317 | Green := 0.0; |
|
| - | 9318 | Blue := 0.0 |
|
| - | 9319 | end; |
|
| - | 9320 | else |
|
| - | 9321 | Red := 0.0; |
|
| - | 9322 | Green := 0.0; |
|
| - | 9323 | Blue := 0.0 |
|
| - | 9324 | end; |
|
| - | 9325 | case Trunc(Wavelength) of |
|
| - | 9326 | 380..419: factor := 0.3 + 0.7 * (Wavelength - 380) / (420 - 380); |
|
| - | 9327 | 420..700: factor := 1.0; |
|
| - | 9328 | 701..780: factor := 0.3 + 0.7 * (780 - Wavelength) / (780 - 700) |
|
| - | 9329 | else |
|
| - | 9330 | factor := 0.0 |
|
| - | 9331 | end; |
|
| - | 9332 | Result := RGB(Adjust(Red, Factor), Adjust(Green, Factor), Adjust(Blue, Factor)); |
|
| - | 9333 | end; |
|
| - | 9334 | ||
| - | 9335 | function Rainbow(const fraction: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9336 | begin |
|
| - | 9337 | if (fraction < 0.0) or (fraction > 1.0) then Result := clBlack |
|
| - | 9338 | else |
|
| - | 9339 | Result := WL2RGB(WavelengthMinimum + Fraction * (WavelengthMaximum - WavelengthMinimum)) |
|
| - | 9340 | end {Raindbow}; |
|
| - | 9341 | ||
| - | 9342 | function ColorInterpolate(const fraction: Double; const Color1, Color2: TColor): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9343 | var |
|
| - | 9344 | complement: Double; |
|
| - | 9345 | R1, R2, G1, G2, B1, B2: BYTE; |
|
| - | 9346 | begin |
|
| - | 9347 | if fraction <= 0 then Result := Color1 |
|
| - | 9348 | else |
|
| - | 9349 | if fraction >= 1.0 then Result := Color2 |
|
| - | 9350 | else |
|
| - | 9351 | begin |
|
| - | 9352 | R1 := GetRValue(Color1); |
|
| - | 9353 | G1 := GetGValue(Color1); |
|
| - | 9354 | B1 := GetBValue(Color1); |
|
| - | 9355 | R2 := GetRValue(Color2); |
|
| - | 9356 | G2 := GetGValue(Color2); |
|
| - | 9357 | B2 := GetBValue(Color2); |
|
| - | 9358 | complement := 1.0 - fraction; |
|
| - | 9359 | Result := RGB(Round(complement * R1 + fraction * R2), |
|
| - | 9360 | Round(complement * G1 + fraction * G2), |
|
| - | 9361 | Round(complement * B1 + fraction * B2)) |
|
| - | 9362 | end |
|
| - | 9363 | end {ColorInterpolate}; |
|
| - | 9364 | ||
| - | 9365 | // Conversion utility routines |
|
| - | 9366 | function ColorToRGBTriple(const Color: TColor): TRGBTriple; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9367 | begin |
|
| - | 9368 | with Result do |
|
| - | 9369 | begin |
|
| - | 9370 | rgbtRed := GetRValue(Color); |
|
| - | 9371 | rgbtGreen := GetGValue(Color); |
|
| - | 9372 | rgbtBlue := GetBValue(Color) |
|
| - | 9373 | end |
|
| - | 9374 | end {ColorToRGBTriple}; |
|
| - | 9375 | ||
| - | 9376 | function RGBTripleToColor(const Triple: TRGBTriple): TColor; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9377 | begin |
|
| - | 9378 | Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue) |
|
| - | 9379 | end {RGBTripleToColor}; |
|
| - | 9380 | // Bresenham's Line Algorithm. Byte, March 1988, pp. 249-253. |
|
| - | 9381 | var |
|
| - | 9382 | a, b, d, diag_inc, dXdg, dXndg, dYdg, dYndg, i, nDginc, nDswap, x, y: Integer; |
|
| - | 9383 | begin {DrawLine} |
|
| - | 9384 | x := iStart.X; |
|
| - | 9385 | y := iStart.Y; |
|
| - | 9386 | a := iEnd.X - iStart.X; |
|
| - | 9387 | b := iEnd.Y - iStart.Y; |
|
| - | 9388 | if a < 0 then |
|
| - | 9389 | begin |
|
| - | 9390 | a := -a; |
|
| - | 9391 | dXdg := -1 |
|
| - | 9392 | end |
|
| - | 9393 | else dXdg := 1; |
|
| - | 9394 | if b < 0 then |
|
| - | 9395 | begin |
|
| - | 9396 | b := -b; |
|
| - | 9397 | dYdg := -1 |
|
| - | 9398 | end |
|
| - | 9399 | else dYdg := 1; |
|
| - | 9400 | if a < b then |
|
| - | 9401 | begin |
|
| - | 9402 | nDswap := a; |
|
| - | 9403 | a := b; |
|
| - | 9404 | b := nDswap; |
|
| - | 9405 | dXndg := 0; |
|
| - | 9406 | dYndg := dYdg |
|
| - | 9407 | end |
|
| - | 9408 | else |
|
| - | 9409 | begin |
|
| - | 9410 | dXndg := dXdg; |
|
| - | 9411 | dYndg := 0 |
|
| - | 9412 | end; |
|
| - | 9413 | d := b + b - a; |
|
| - | 9414 | nDginc := b + b; |
|
| - | 9415 | diag_inc := b + b - a - a; |
|
| - | 9416 | for i := 0 to a do |
|
| - | 9417 | begin |
|
| - | 9418 | case iPixelGeometry of |
|
| - | 9419 | pgPoint: |
|
| - | 9420 | case iColorStyle of |
|
| - | 9421 | csSolid: |
|
| - | 9422 | Canvas.Pixels[x, y] := tempColor; |
|
| - | 9423 | csGradient: |
|
| - | 9424 | Canvas.Pixels[x, y] := ColorInterpolate(i / a, iGradientFrom, iGradientTo); |
|
| - | 9425 | csRainbow: |
|
| - | 9426 | Canvas.Pixels[x, y] := Rainbow(i / a) |
|
| - | 9427 | end; |
|
| - | 9428 | pgCircular: |
|
| - | 9429 | begin |
|
| - | 9430 | case iColorStyle of |
|
| - | 9431 | csSolid: ; |
|
| - | 9432 | csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo)); |
|
| - | 9433 | csRainbow: SetColor(Rainbow(i / a)) |
|
| - | 9434 | end; |
|
| - | 9435 | Canvas.Ellipse(x - iRadius, y - iRadius, x + iRadius, y + iRadius) |
|
| - | 9436 | end; |
|
| - | 9437 | pgRectangular: |
|
| - | 9438 | begin |
|
| - | 9439 | case iColorStyle of |
|
| - | 9440 | csSolid: ; |
|
| - | 9441 | csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo)); |
|
| - | 9442 | csRainbow: SetColor(Rainbow(i / a)) |
|
| - | 9443 | end; |
|
| - | 9444 | Canvas.Rectangle(x - iRadius, y - iRadius, x + iRadius, y + iRadius) |
|
| - | 9445 | end |
|
| - | 9446 | end; |
|
| - | 9447 | if d < 0 then |
|
| - | 9448 | begin |
|
| - | 9449 | Inc(x, dXndg); |
|
| - | 9450 | Inc(y, dYndg); |
|
| - | 9451 | Inc(d, nDginc); |
|
| - | 9452 | end |
|
| - | 9453 | else |
|
| - | 9454 | begin |
|
| - | 9455 | Inc(x, dXdg); |
|
| - | 9456 | Inc(y, dYdg); |
|
| - | 9457 | Inc(d, diag_inc); |
|
| - | 9458 | end |
|
| - | 9459 | end |
|
| - | 9460 | end {Line}; |
|
| - | 9461 | ||
| - | 9462 | procedure TDIB.DoNovaEffect(sr, sg, sb, cx, cy, radius, |
|
| - | 9463 | nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent); |
|
| - | 9464 | // Copyright (c) 2000 by Keith Murray (kmurray@hotfreeware.com) |
|
| - | 9465 | // All rights reserved. |
|
| - | 9466 | // Adapted for DIB by JB. |
|
| - | 9467 | type |
|
| - | 9468 | PByteArray = ^TByteArray; |
|
| - | 9469 | TByteArray = array[0..32767] of Byte; |
|
| - | 9470 | PDoubleArray = ^TDoubleArray; |
|
| - | 9471 | TDoubleArray = array[0..32767] of Double; |
|
| - | 9472 | PIntegerArray = ^TIntegerArray; |
|
| - | 9473 | TIntegerArray = array[0..32767] of Integer; |
|
| - | 9474 | type |
|
| - | 9475 | TProgressEvent = procedure(progress: Integer; message: string; |
|
| - | 9476 | var cancel: Boolean) of object; |
|
| - | 9477 | const |
|
| - | 9478 | M_PI = 3.14159265358979323846; |
|
| - | 9479 | RAND_MAX = 2147483647; |
|
| - | 9480 | ||
| - | 9481 | function Gauss: double; |
|
| - | 9482 | const magnitude = 6; |
|
| - | 9483 | var |
|
| - | 9484 | sum: double; |
|
| - | 9485 | i: Integer; |
|
| - | 9486 | begin |
|
| - | 9487 | sum := 0; |
|
| - | 9488 | for i := 1 to magnitude do |
|
| - | 9489 | sum := sum + (randgauss / 2147483647); |
|
| - | 9490 | result := sum / magnitude; |
|
| - | 9491 | end; |
|
| - | 9492 | ||
| - | 9493 | function Clamp(i, l, h: double): double; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9494 | begin |
|
| - | 9495 | if i < l then |
|
| - | 9496 | result := l |
|
| - | 9497 | else |
|
| - | 9498 | if i > h then |
|
| - | 9499 | result := h |
|
| - | 9500 | else |
|
| - | 9501 | result := i; |
|
| - | 9502 | end; |
|
| - | 9503 | ||
| - | 9504 | function IClamp(i, l, h: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9505 | begin |
|
| - | 9506 | if i < l then |
|
| - | 9507 | result := l |
|
| - | 9508 | else if i > h then |
|
| - | 9509 | result := h |
|
| - | 9510 | else result := i; |
|
| - | 9511 | end; |
|
| - | 9512 | ||
| - | 9513 | procedure rgb_to_hsl(r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9514 | {$IFNDEF VER4UP} |
|
| - | 9515 | function Max(a, b: Double): Double; |
|
| - | 9516 | begin |
|
| - | 9517 | Result := a; if b > a then Result := b; |
|
| - | 9518 | end; |
|
| - | 9519 | function Min(a, b: Double): Double; |
|
| - | 9520 | begin |
|
| - | 9521 | Result := a; if b < a then Result := b; |
|
| - | 9522 | end; |
|
| - | 9523 | {$ENDIF} |
|
| - | 9524 | var |
|
| - | 9525 | v, m, vm: Double; |
|
| - | 9526 | r2, g2, b2: Double; |
|
| - | 9527 | begin |
|
| - | 9528 | h := 0; |
|
| - | 9529 | s := 0; |
|
| - | 9530 | l := 0; |
|
| - | 9531 | v := Max(r, g); |
|
| - | 9532 | v := Max(v, b); |
|
| - | 9533 | m := Min(r, g); |
|
| - | 9534 | m := Min(m, b); |
|
| - | 9535 | l := (m + v) / 2.0; |
|
| - | 9536 | if l <= 0.0 then |
|
| - | 9537 | exit; |
|
| - | 9538 | vm := v - m; |
|
| - | 9539 | s := vm; |
|
| - | 9540 | if s > 0.0 then |
|
| - | 9541 | begin |
|
| - | 9542 | if l <= 0.5 then |
|
| - | 9543 | s := s / (v + m) |
|
| - | 9544 | else s := s / (2.0 - v - m); |
|
| - | 9545 | end |
|
| - | 9546 | else exit; |
|
| - | 9547 | r2 := (v - 4) / vm; |
|
| - | 9548 | g2 := (v - g) / vm; |
|
| - | 9549 | b2 := (v - b) / vm; |
|
| - | 9550 | if r = v then |
|
| - | 9551 | begin |
|
| - | 9552 | if g = m then |
|
| - | 9553 | h := b2 + 5.0 |
|
| - | 9554 | else h := 1.0 - g2; |
|
| - | 9555 | end |
|
| - | 9556 | else if g = v then |
|
| - | 9557 | begin |
|
| - | 9558 | if b = m then |
|
| - | 9559 | h := 1.0 + r2 |
|
| - | 9560 | else h := 3.0 - b2; |
|
| - | 9561 | end |
|
| - | 9562 | else |
|
| - | 9563 | begin |
|
| - | 9564 | if r = m then |
|
| - | 9565 | h := 3.0 + g2 |
|
| - | 9566 | else h := 5.0 - r2; |
|
| - | 9567 | end; |
|
| - | 9568 | h := h / 6; |
|
| - | 9569 | end; |
|
| - | 9570 | ||
| - | 9571 | procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF} |
|
| - | 9572 | var |
|
| - | 9573 | v: Double; |
|
| - | 9574 | m, sv: Double; |
|
| - | 9575 | sextant: Integer; |
|
| - | 9576 | fract, vsf, mid1, mid2: Double; |
|
| - | 9577 | begin |
|
| - | 9578 | if l <= 0.5 then |
|
| - | 9579 | v := l * (1.0 + sl) |
|
| - | 9580 | else v := l + sl - l * sl; |
|
| - | 9581 | if v <= 0 then |
|
| - | 9582 | begin |
|
| - | 9583 | r := 0.0; |
|
| - | 9584 | g := 0.0; |
|
| - | 9585 | b := 0.0; |
|
| - | 9586 | end |
|
| - | 9587 | else |
|
| - | 9588 | begin |
|
| - | 9589 | m := l + l - v; |
|
| - | 9590 | sv := (v - m) / v; |
|
| - | 9591 | h := h * 6.0; |
|
| - | 9592 | sextant := Trunc(h); |
|
| - | 9593 | fract := h - sextant; |
|
| - | 9594 | vsf := v * sv * fract; |
|
| - | 9595 | mid1 := m + vsf; |
|
| - | 9596 | mid2 := v - vsf; |
|
| - | 9597 | case sextant of |
|
| - | 9598 | 0: |
|
| - | 9599 | begin |
|
| - | 9600 | r := v; g := mid1; b := m; |
|
| - | 9601 | end; |
|
| - | 9602 | 1: |
|
| - | 9603 | begin |
|
| - | 9604 | r := mid2; g := v; b := m; |
|
| - | 9605 | end; |
|
| - | 9606 | 2: |
|
| - | 9607 | begin |
|
| - | 9608 | r := m; g := v; b := mid1; |
|
| - | 9609 | end; |
|
| - | 9610 | 3: |
|
| - | 9611 | begin |
|
| - | 9612 | r := m; g := mid2; b := v; |
|
| - | 9613 | end; |
|
| - | 9614 | 4: |
|
| - | 9615 | begin |
|
| - | 9616 | r := mid1; g := m; b := v; |
|
| - | 9617 | end; |
|
| - | 9618 | 5: |
|
| - | 9619 | begin |
|
| - | 9620 | r := v; g := m; b := mid2; |
|
| - | 9621 | end; |
|
| - | 9622 | end; |
|
| - | 9623 | end; |
|
| - | 9624 | end; |
|
| - | 9625 | ||
| - | 9626 | var |
|
| - | 9627 | src_row, dest_row: PByte; |
|
| - | 9628 | src, dest: PByteArray; |
|
| - | 9629 | color, colors: array[0..3] of Integer; |
|
| - | 9630 | SpokeColor: PIntegerArray; |
|
| - | 9631 | spoke: PDoubleArray; |
|
| - | 9632 | x1, y1, x2, y2, row, col, x, y, alpha, has_alpha, bpp, progress, max_progress, xc, yc, i, j: Integer; |
|
| - | 9633 | u, v, l, l0, w, w1, c, nova_alpha, src_alpha, new_alpha, compl_ratio, ratio, r, g, b, h, s, lu, SpokeCol: Double; |
|
| - | 9634 | dstDIB: TDIB; |
|
| - | 9635 | begin |
|
| - | 9636 | colors[0] := sr; |
|
| - | 9637 | colors[1] := sg; |
|
| - | 9638 | colors[2] := sb; |
|
| - | 9639 | new_alpha := 0; |
|
| - | 9640 | ||
| - | 9641 | GetMem(spoke, NSpokes * sizeof(Double)); |
|
| - | 9642 | GetMem(spokecolor, NSpokes * sizeof(Integer) * 3); |
|
| - | 9643 | dstDIB := TDIB.Create; |
|
| - | 9644 | dstDIB.Assign(Self); |
|
| - | 9645 | dstDIB.Canvas.Brush.Color := clBlack; |
|
| - | 9646 | dstDIB.Canvas.FillRect(dstDIB.Canvas.ClipRect); |
|
| - | 9647 | try |
|
| - | 9648 | rgb_to_hsl(colors[0] / 255.0, colors[1] / 255.0, colors[2] / 255.0, h, s, lu); |
|
| - | 9649 | ||
| - | 9650 | for i := 0 to NSpokes - 1 do |
|
| - | 9651 | begin |
|
| - | 9652 | spoke[i] := gauss; |
|
| - | 9653 | h := h + randomhue / 360.0 * ({Random(RAND_MAX)}RandomSpok / RAND_MAX - 0.5); |
|
| - | 9654 | if h < 0 then |
|
| - | 9655 | h := h + 1.0 |
|
| - | 9656 | else if h > 1.0 then |
|
| - | 9657 | h := h - 1.0; |
|
| - | 9658 | hsl_to_rgb(h, s, lu, r, g, b); |
|
| - | 9659 | spokecolor[3 * i + 0] := Trunc(255 * r); |
|
| - | 9660 | spokecolor[3 * i + 1] := Trunc(255 * g); |
|
| - | 9661 | spokecolor[3 * i + 2] := Trunc(255 * b); |
|
| - | 9662 | end; |
|
| - | 9663 | ||
| - | 9664 | xc := cx; |
|
| - | 9665 | yc := cy; |
|
| - | 9666 | l0 := (x2 - xc) / 4 + 1; |
|
| - | 9667 | bpp := Self.BitCount div 8; |
|
| - | 9668 | has_alpha := 0; |
|
| - | 9669 | alpha := bpp; |
|
| - | 9670 | y := 0; |
|
| - | 9671 | for row := 0 to Self.Height - 1 do begin |
|
| - | 9672 | src_row := Self.ScanLine[row]; |
|
| - | 9673 | dest_row := dstDIB.ScanLine[row]; |
|
| - | 9674 | src := Pointer(src_row); |
|
| - | 9675 | dest := Pointer(dest_row); |
|
| - | 9676 | x := 0; |
|
| - | 9677 | for col := 0 to Self.Width - 1 do begin |
|
| - | 9678 | u := (x - xc) / radius; |
|
| - | 9679 | v := (y - yc) / radius; |
|
| - | 9680 | l := sqrt((u * u) + (v * v)); |
|
| - | 9681 | c := (arctan2(u, v) / (2 * M_PI) + 0.51) * NSpokes; |
|
| - | 9682 | i := floor(c); |
|
| - | 9683 | c := c - i; |
|
| - | 9684 | i := i mod NSpokes; |
|
| - | 9685 | w1 := spoke[i] * (1 - c) + spoke[(i + 1) mod NSpokes] * c; |
|
| - | 9686 | w1 := w1 * w1; |
|
| - | 9687 | w := 1 / (l + 0.001) * 0.9; |
|
| - | 9688 | nova_alpha := Clamp(w, 0.0, 1.0); |
|
| - | 9689 | ratio := nova_alpha; |
|
| - | 9690 | compl_ratio := 1.0 - ratio; |
|
| - | 9691 | for j := 0 to alpha - 1 do |
|
| - | 9692 | begin |
|
| - | 9693 | spokecol := spokecolor[3 * i + j] * (1.0 - c) + spokecolor[3 * ((i + 1) mod nspokes) + j] * c; |
|
| - | 9694 | if w > 1.0 then |
|
| - | 9695 | color[j] := IClamp(Trunc(spokecol * w), 0, 255) |
|
| - | 9696 | else |
|
| - | 9697 | color[j] := Trunc(src[j] * compl_ratio + spokecol * ratio); |
|
| - | 9698 | color[j] := Trunc(color[j] + 255 * Clamp(w1 * w, 0.0, 1.0)); |
|
| - | 9699 | dest[j] := IClamp(color[j], 0, 255); |
|
| - | 9700 | end; |
|
| - | 9701 | inc(Integer(src), bpp); |
|
| - | 9702 | inc(Integer(dest), bpp); |
|
| - | 9703 | inc(x); |
|
| - | 9704 | end; |
|
| - | 9705 | inc(y); |
|
| - | 9706 | end; |
|
| - | 9707 | finally |
|
| - | 9708 | Self.Assign(dstDIB); |
|
| - | 9709 | dstDIB.Free; |
|
| - | 9710 | FreeMem(Spoke); |
|
| - | 9711 | FreeMem(SpokeColor); |
|
| - | 9712 | end; |
|
| - | 9713 | end; |
|
| - | 9714 | ||
| - | 9715 | procedure TDIB.DrawMandelbrot(ao, au: Integer; bo, bu: Double); |
|
| - | 9716 | var |
|
| - | 9717 | c1, c2, z1, z2, tmp: Double; |
|
| - | 9718 | i, j, Count: Integer; |
|
| - | 9719 | dstDIB: TDIB; |
|
| - | 9720 | X, Y: Double; |
|
| - | 9721 | X2, Y2: Integer; |
|
| - | 9722 | begin |
|
| - | 9723 | dstDIB := TDIB.Create; |
|
| - | 9724 | dstDIB.Assign(Self); |
|
| - | 9725 | X2 := dstDIB.FWidth; |
|
| - | 9726 | Y2 := dstDIB.FHeight; |
|
| - | 9727 | {as Example |
|
| - | 9728 | ao := 1; |
|
| - | 9729 | au := -2; |
|
| - | 9730 | bo := 1.5; |
|
| - | 9731 | bu := -1.5; |
|
| - | 9732 | } |
|
| - | 9733 | X := (ao - au) / dstDIB.FWidth; |
|
| - | 9734 | Y := (bo - bu) / dstDIB.FHeight; |
|
| - | 9735 | try |
|
| - | 9736 | c2 := bu; |
|
| - | 9737 | for i := 10 to X2 do |
|
| - | 9738 | begin |
|
| - | 9739 | c1 := au; |
|
| - | 9740 | for j := 0 to Y2 do |
|
| - | 9741 | begin |
|
| - | 9742 | z1 := 0; |
|
| - | 9743 | z2 := 0; |
|
| - | 9744 | Count := 0; |
|
| - | 9745 | {count is deep of iteration of the mandelbrot set |
|
| - | 9746 | if |z| >=2 then z is not a member of a mandelset} |
|
| - | 9747 | while (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do |
|
| - | 9748 | begin |
|
| - | 9749 | tmp := z1; |
|
| - | 9750 | z1 := z1 * z1 - z2 * z2 + c1; |
|
| - | 9751 | z2 := 2 * tmp * z2 + c2; |
|
| - | 9752 | Inc(Count); |
|
| - | 9753 | end; |
|
| - | 9754 | //the color-palette depends on TColor(n*count mod t) |
|
| - | 9755 | dstDIB.Canvas.Pixels[j, i] := (16 * Count mod 255); |
|
| - | 9756 | c1 := c1 + X; |
|
| - | 9757 | end; |
|
| - | 9758 | c2 := c2 + Y; |
|
| - | 9759 | end; |
|
| - | 9760 | finally |
|
| - | 9761 | Self.Assign(dstDIB); |
|
| - | 9762 | dstDIB.Free; |
|
| - | 9763 | end; |
|
| - | 9764 | end; |
|
| - | 9765 | ||
| - | 9766 | procedure TDIB.SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF}); |
|
| - | 9767 | {Note: when depth parameter set to 0 will produce black and white picture only} |
|
| - | 9768 | var |
|
| - | 9769 | color, color2: longint; |
|
| - | 9770 | r, g, b, rr, gg: byte; |
|
| - | 9771 | h, w: Integer; |
|
| - | 9772 | p0: pbytearray; |
|
| - | 9773 | x, y: Integer; |
|
| - | 9774 | begin |
|
| - | 9775 | if Self.BitCount = 24 then |
|
| - | 9776 | begin |
|
| - | 9777 | Self.DoGrayScale; |
|
| - | 9778 | for y := 0 to Self.Height - 1 do |
|
| - | 9779 | begin |
|
| - | 9780 | p0 := Self.ScanLine[y]; |
|
| - | 9781 | for x := 0 to Self.Width - 1 do |
|
| - | 9782 | begin |
|
| - | 9783 | r := p0[x * 3]; |
|
| - | 9784 | g := p0[x * 3 + 1]; |
|
| - | 9785 | b := p0[x * 3 + 2]; |
|
| - | 9786 | rr := r + (depth * 2); |
|
| - | 9787 | gg := g + depth; |
|
| - | 9788 | if rr <= ((depth * 2) - 1) then |
|
| - | 9789 | rr := 255; |
|
| - | 9790 | if gg <= (depth - 1) then |
|
| - | 9791 | gg := 255; |
|
| - | 9792 | p0[x * 3] := rr; |
|
| - | 9793 | p0[x * 3 + 1] := gg; |
|
| - | 9794 | p0[x * 3 + 2] := b; |
|
| - | 9795 | end; |
|
| - | 9796 | end; |
|
| - | 9797 | Exit |
|
| - | 9798 | end; |
|
| - | 9799 | {this alogorithm is slower because does not use scanline property} |
|
| - | 9800 | for h := 0 to Self.Height-1 do |
|
| - | 9801 | begin |
|
| - | 9802 | for w := 0 to Self.Width-1 do |
|
| - | 9803 | begin |
|
| - | 9804 | //first convert the bitmap to greyscale |
|
| - | 9805 | color := ColorToRGB(Self.Canvas.Pixels[w, h]); |
|
| - | 9806 | r := GetRValue(color); |
|
| - | 9807 | g := GetGValue(color); |
|
| - | 9808 | b := GetBValue(color); |
|
| - | 9809 | color2 := (r + g + b) div 3; |
|
| - | 9810 | Self.Canvas.Pixels[w, h] := RGB(color2, color2, color2); |
|
| - | 9811 | //then convert it to sepia |
|
| - | 9812 | color := ColorToRGB(Self.Canvas.Pixels[w, h]); |
|
| - | 9813 | r := GetRValue(color); |
|
| - | 9814 | g := GetGValue(color); |
|
| - | 9815 | b := GetBValue(color); |
|
| - | 9816 | rr := r + (depth * 2); |
|
| - | 9817 | gg := g + depth; |
|
| - | 9818 | if rr <= ((depth * 2) - 1) then |
|
| - | 9819 | rr := 255; |
|
| - | 9820 | if gg <= (depth - 1) then |
|
| - | 9821 | gg := 255; |
|
| - | 9822 | Self.Canvas.Pixels[w, h] := RGB(rr, gg, b); |
|
| - | 9823 | end; |
|
| - | 9824 | end; |
|
| - | 9825 | ||
| - | 9826 | end; |
|
| - | 9827 | ||
| - | 9828 | procedure TDIB.EncryptDecrypt(const Key: Integer); |
|
| - | 9829 | {for decript call it again} |
|
| - | 9830 | var |
|
| - | 9831 | BytesPorScan: Integer; |
|
| - | 9832 | w, h: Integer; |
|
| - | 9833 | p: pByteArray; |
|
| - | 9834 | begin |
|
| - | 9835 | try |
|
| - | 9836 | BytesPorScan := Abs(Integer(Self.ScanLine[1]) - |
|
| - | 9837 | Integer(Self.ScanLine[0])); |
|
| - | 9838 | except |
|
| - | 9839 | raise Exception.Create('Error '); |
|
| - | 9840 | end; |
|
| - | 9841 | RandSeed := Key; |
|
| - | 9842 | for h := 0 to Self.Height - 1 do |
|
| - | 9843 | begin |
|
| - | 9844 | P := Self.ScanLine[h]; |
|
| - | 9845 | for w := 0 to BytesPorScan - 1 do |
|
| - | 9846 | P^[w] := P^[w] xor Random(256); |
|
| - | 9847 | end; |
|
| - | 9848 | end; |
|
| - | 9849 | ||
| - | 9850 | procedure TDIB.LinePolar(x, y: Integer; AngleInDegree, Length: extended; Color: cardinal); |
|
| - | 9851 | var |
|
| - | 9852 | xp, yp: Integer; |
|
| - | 9853 | begin |
|
| - | 9854 | xp := Round(Sin(AngleInDegree * Pi / 180) * Length) + x; |
|
| - | 9855 | yp := Round(Cos(AngleInDegree * Pi / 180) * Length) + y; |
|
| - | 9856 | AntialiasedLine(x, y, xp, yp, Color); |
|
| - | 9857 | end; |
|
| - | 9858 | ||
| - | 9859 | //y = 0.299*g + 0.587*b + 0.114*r; |
|
| - | 9860 | ||
| - | 9861 | procedure TDIB.BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: byte); |
|
| - | 9862 | var |
|
| - | 9863 | cR, cG, cB: byte; |
|
| - | 9864 | aR, aG, aB: byte; |
|
| - | 9865 | dColor: Cardinal; |
|
| - | 9866 | begin |
|
| - | 9867 | aR := GetRValue(aColor); |
|
| - | 9868 | aG := GetGValue(aColor); |
|
| - | 9869 | aB := GetBValue(aColor); |
|
| - | 9870 | dColor := Self.Canvas.Pixels[x, y]; |
|
| - | 9871 | cR := GetRValue(dColor); |
|
| - | 9872 | cG := GetGValue(dColor); |
|
| - | 9873 | cB := GetBValue(dColor); |
|
| - | 9874 | Canvas.Pixels[x, y] := RGB((Alpha * (aR - cR) shr 8) + cR, // R alpha |
|
| - | 9875 | (Alpha * (aG - cG) shr 8) + cG, // G alpha |
|
| - | 9876 | (Alpha * (aB - cB) shr 8) + cB); // B alpha |
|
| - | 9877 | end; |
|
| - | 9878 | ||
| - | 9879 | ||
| - | 9880 | procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP} overload; {$ENDIF} |
|
| - | 9881 | begin |
|
| - | 9882 | DIB := TDIB.Create; |
|
| - | 9883 | DIB.SetSize(iWidth, iHeight, iBitCount); |
|
| - | 9884 | DIB.Fill(iFillColor); |
|
| - | 9885 | end; |
|
| - | 9886 | ||
| - | 9887 | procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDib2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP} overload; {$ENDIF} |
|
| - | 9888 | begin |
|
| - | 9889 | DIB := TDIB.Create; |
|
| - | 9890 | if Assigned(iBitmap) then |
|
| - | 9891 | DIB.CreateDIBFromBitmap(iBitmap) |
|
| - | 9892 | else |
|
| - | 9893 | DIB.Fill(clBlack); |
|
| - | 9894 | end; |
|
| - | 9895 | ||
| 3231 | initialization |
9896 | initialization |
| 3232 | TPicture.RegisterClipBoardFormat(CF_DIB, TDIB); |
9897 | TPicture.RegisterClipBoardFormat(CF_DIB, TDIB); |
| 3233 | TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB); |
9898 | TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB); |
| 3234 | finalization |
9899 | finalization |
| 3235 | TPicture.UnRegisterGraphicClass(TDIB); |
9900 | TPicture.UnRegisterGraphicClass(TDIB); |
| 3236 | 9901 | ||
| 3237 | FEmptyDIBImage.Free; |
9902 | FEmptyDIBImage.Free; |
| 3238 | FPaletteManager.Free; |
9903 | FPaletteManager.Free; |
| 3239 | end. |
9904 | end. |
| 3240 | 9905 | ||