Rev 1 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed
Rev | Author | Line No. | Line |
---|---|---|---|
4 | daniel-mar | 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 | daniel-mar | 22 | unit DIB; |
23 | |||
24 | interface |
||
25 | |||
26 | {$INCLUDE DelphiXcfg.inc} |
||
4 | daniel-mar | 27 | {$DEFINE USE_SCANLINE} |
1 | daniel-mar | 28 | |
29 | uses |
||
4 | daniel-mar | 30 | Windows, SysUtils, Classes, Graphics, Controls, |
31 | {$IFDEF VER17UP} Types, UITypes,{$ENDIF} |
||
32 | Math; |
||
1 | daniel-mar | 33 | |
34 | type |
||
4 | daniel-mar | 35 | TColorLineStyle = (csSolid, csGradient, csRainbow); |
36 | TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular); |
||
37 | PRGBQuads = ^TRGBQuads; |
||
1 | daniel-mar | 38 | TRGBQuads = array[0..255] of TRGBQuad; |
39 | |||
40 | TPaletteEntries = array[0..255] of TPaletteEntry; |
||
41 | |||
42 | PBGR = ^TBGR; |
||
43 | TBGR = packed record |
||
44 | B, G, R: Byte; |
||
45 | end; |
||
46 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 57 | PArrayBGR = ^TArrayBGR; |
58 | TArrayBGR = array[0..10000] of TBGR; |
||
59 | |||
60 | PArrayByte = ^TArrayByte; |
||
61 | TArrayByte = array[0..10000] of Byte; |
||
62 | |||
63 | PArrayWord = ^TArrayWord; |
||
64 | TArrayWord = array[0..10000] of Word; |
||
65 | |||
66 | PArrayDWord = ^TArrayDWord; |
||
67 | TArrayDWord = array[0..10000] of DWord; |
||
68 | |||
4 | daniel-mar | 69 | { TDIBPixelFormat } |
1 | daniel-mar | 70 | |
71 | TDIBPixelFormat = record |
||
72 | RBitMask, GBitMask, BBitMask: DWORD; |
||
73 | RBitCount, GBitCount, BBitCount: DWORD; |
||
74 | RShift, GShift, BShift: DWORD; |
||
75 | RBitCount2, GBitCount2, BBitCount2: DWORD; |
||
76 | end; |
||
77 | |||
4 | daniel-mar | 78 | { TDIBSharedImage } |
79 | |||
1 | daniel-mar | 80 | TDIBSharedImage = class(TSharedImage) |
4 | daniel-mar | 81 | private |
1 | daniel-mar | 82 | FBitCount: Integer; |
83 | FBitmapInfo: PBitmapInfo; |
||
84 | FBitmapInfoSize: Integer; |
||
85 | FChangePalette: Boolean; |
||
86 | FColorTable: TRGBQuads; |
||
87 | FColorTablePos: Integer; |
||
88 | FCompressed: Boolean; |
||
89 | FDC: THandle; |
||
90 | FHandle: THandle; |
||
91 | FHeight: Integer; |
||
92 | FMemoryImage: Boolean; |
||
93 | FNextLine: Integer; |
||
94 | FOldHandle: THandle; |
||
95 | FPalette: HPalette; |
||
96 | FPaletteCount: Integer; |
||
97 | FPBits: Pointer; |
||
98 | FPixelFormat: TDIBPixelFormat; |
||
99 | FSize: Integer; |
||
100 | FTopPBits: Pointer; |
||
101 | FWidth: Integer; |
||
102 | FWidthBytes: Integer; |
||
103 | constructor Create; |
||
104 | procedure NewImage(AWidth, AHeight, ABitCount: Integer; |
||
105 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
||
4 | daniel-mar | 106 | procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF} |
1 | daniel-mar | 107 | procedure Compress(Source: TDIBSharedImage); |
108 | procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
109 | procedure ReadData(Stream: TStream; MemoryImage: Boolean); |
||
110 | function GetPalette: THandle; |
||
111 | procedure SetColorTable(const Value: TRGBQuads); |
||
112 | protected |
||
113 | procedure FreeHandle; override; |
||
114 | public |
||
115 | destructor Destroy; override; |
||
116 | end; |
||
117 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 145 | TDIB = class(TGraphic) |
146 | private |
||
147 | FCanvas: TCanvas; |
||
4 | daniel-mar | 148 | FImage: TDIBSharedImage; |
1 | daniel-mar | 149 | |
150 | FProgressName: string; |
||
151 | FProgressOldY: DWORD; |
||
152 | FProgressOldTime: DWORD; |
||
153 | FProgressOld: DWORD; |
||
154 | FProgressY: DWORD; |
||
155 | { For speed-up } |
||
156 | FBitCount: Integer; |
||
157 | FHeight: Integer; |
||
158 | FNextLine: Integer; |
||
159 | FNowPixelFormat: TDIBPixelFormat; |
||
160 | FPBits: Pointer; |
||
161 | FSize: Integer; |
||
162 | FTopPBits: Pointer; |
||
163 | FWidth: Integer; |
||
164 | FWidthBytes: Integer; |
||
4 | daniel-mar | 165 | FLUTDist: array[0..255, 0..255] of Integer; |
166 | LG_COUNT: Integer; |
||
167 | LG_DETAIL: Integer; |
||
168 | FFreeList: TList; |
||
1 | daniel-mar | 169 | procedure AllocHandle; |
170 | procedure CanvasChanging(Sender: TObject); |
||
171 | procedure Changing(MemoryImage: Boolean); |
||
172 | procedure ConvertBitCount(ABitCount: Integer); |
||
173 | function GetBitmapInfo: PBitmapInfo; |
||
174 | function GetBitmapInfoSize: Integer; |
||
175 | function GetCanvas: TCanvas; |
||
176 | function GetHandle: THandle; |
||
177 | function GetPaletteCount: Integer; |
||
178 | function GetPixel(X, Y: Integer): DWORD; |
||
179 | function GetPBits: Pointer; |
||
180 | function GetPBitsReadOnly: Pointer; |
||
181 | function GetScanLine(Y: Integer): Pointer; |
||
182 | function GetScanLineReadOnly(Y: Integer): Pointer; |
||
183 | function GetTopPBits: Pointer; |
||
184 | function GetTopPBitsReadOnly: Pointer; |
||
185 | procedure SetBitCount(Value: Integer); |
||
4 | daniel-mar | 186 | procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF} |
1 | daniel-mar | 187 | procedure SetNowPixelFormat(const Value: TDIBPixelFormat); |
188 | procedure SetPixel(X, Y: Integer; Value: DWORD); |
||
189 | procedure StartProgress(const Name: string); |
||
190 | procedure EndProgress; |
||
191 | procedure UpdateProgress(PercentY: Integer); |
||
4 | daniel-mar | 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); |
||
1 | daniel-mar | 205 | protected |
206 | procedure DefineProperties(Filer: TFiler); override; |
||
4 | daniel-mar | 207 | procedure Draw(ACanvas: TCanvas; const ARect: TRect); override; |
1 | daniel-mar | 208 | function GetEmpty: Boolean; override; |
209 | function GetHeight: Integer; override; |
||
210 | function GetPalette: HPalette; override; |
||
211 | function GetWidth: Integer; override; |
||
212 | procedure ReadData(Stream: TStream); override; |
||
213 | procedure SetHeight(Value: Integer); override; |
||
214 | procedure SetPalette(Value: HPalette); override; |
||
215 | procedure SetWidth(Value: Integer); override; |
||
216 | procedure WriteData(Stream: TStream); override; |
||
217 | public |
||
218 | ColorTable: TRGBQuads; |
||
219 | PixelFormat: TDIBPixelFormat; |
||
220 | constructor Create; override; |
||
221 | destructor Destroy; override; |
||
222 | procedure Assign(Source: TPersistent); override; |
||
223 | procedure Clear; |
||
224 | procedure Compress; |
||
225 | procedure Decompress; |
||
226 | procedure FreeHandle; |
||
4 | daniel-mar | 227 | function HasAlphaChannel: Boolean; |
228 | function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean; |
||
229 | procedure RetAlphaChannel(out oDIB: TDIB); |
||
1 | daniel-mar | 230 | procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
231 | APalette: HPALETTE); override; |
||
232 | procedure LoadFromStream(Stream: TStream); override; |
||
233 | procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
||
234 | var APalette: HPALETTE); override; |
||
235 | procedure SaveToStream(Stream: TStream); override; |
||
4 | daniel-mar | 236 | procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF} |
1 | daniel-mar | 237 | procedure UpdatePalette; |
238 | { Special effect } |
||
239 | procedure Blur(ABitCount: Integer; Radius: Integer); |
||
240 | procedure Greyscale(ABitCount: Integer); |
||
241 | procedure Mirror(MirrorX, MirrorY: Boolean); |
||
242 | procedure Negative; |
||
243 | |||
4 | daniel-mar | 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 |
||
1 | daniel-mar | 398 | property BitCount: Integer read FBitCount write SetBitCount; |
399 | property BitmapInfo: PBitmapInfo read GetBitmapInfo; |
||
400 | property BitmapInfoSize: Integer read GetBitmapInfoSize; |
||
401 | property Canvas: TCanvas read GetCanvas; |
||
402 | property Handle: THandle read GetHandle; |
||
403 | property Height: Integer read FHeight write SetHeight; |
||
404 | property NextLine: Integer read FNextLine; |
||
405 | property NowPixelFormat: TDIBPixelFormat read FNowPixelFormat write SetNowPixelFormat; |
||
406 | property PaletteCount: Integer read GetPaletteCount; |
||
407 | property PBits: Pointer read GetPBits; |
||
408 | property PBitsReadOnly: Pointer read GetPBitsReadOnly; |
||
409 | property Pixels[X, Y: Integer]: DWORD read GetPixel write SetPixel; |
||
410 | property ScanLine[Y: Integer]: Pointer read GetScanLine; |
||
411 | property ScanLineReadOnly[Y: Integer]: Pointer read GetScanLineReadOnly; |
||
412 | property Size: Integer read FSize; |
||
413 | property TopPBits: Pointer read GetTopPBits; |
||
414 | property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly; |
||
415 | property Width: Integer read FWidth write SetWidth; |
||
416 | property WidthBytes: Integer read FWidthBytes; |
||
4 | daniel-mar | 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; |
||
1 | daniel-mar | 422 | end; |
423 | |||
4 | daniel-mar | 424 | { TDIBitmap } |
425 | |||
1 | daniel-mar | 426 | TDIBitmap = class(TDIB) end; |
427 | |||
428 | { TCustomDXDIB } |
||
429 | |||
430 | TCustomDXDIB = class(TComponent) |
||
431 | private |
||
432 | FDIB: TDIB; |
||
433 | procedure SetDIB(Value: TDIB); |
||
434 | public |
||
435 | constructor Create(AOnwer: TComponent); override; |
||
436 | destructor Destroy; override; |
||
437 | property DIB: TDIB read FDIB write SetDIB; |
||
438 | end; |
||
439 | |||
440 | { TDXDIB } |
||
441 | |||
442 | TDXDIB = class(TCustomDXDIB) |
||
443 | published |
||
444 | property DIB; |
||
445 | end; |
||
446 | |||
447 | { TCustomDXPaintBox } |
||
448 | |||
449 | TCustomDXPaintBox = class(TGraphicControl) |
||
450 | private |
||
451 | FAutoStretch: Boolean; |
||
452 | FCenter: Boolean; |
||
453 | FDIB: TDIB; |
||
454 | FKeepAspect: Boolean; |
||
455 | FStretch: Boolean; |
||
456 | FViewWidth: Integer; |
||
457 | FViewHeight: Integer; |
||
458 | procedure SetAutoStretch(Value: Boolean); |
||
459 | procedure SetCenter(Value: Boolean); |
||
460 | procedure SetDIB(Value: TDIB); |
||
461 | procedure SetKeepAspect(Value: Boolean); |
||
462 | procedure SetStretch(Value: Boolean); |
||
463 | procedure SetViewWidth(Value: Integer); |
||
464 | procedure SetViewHeight(Value: Integer); |
||
465 | protected |
||
466 | function GetPalette: HPALETTE; override; |
||
467 | public |
||
468 | constructor Create(AOwner: TComponent); override; |
||
469 | destructor Destroy; override; |
||
470 | procedure Paint; override; |
||
471 | property AutoStretch: Boolean read FAutoStretch write SetAutoStretch; |
||
472 | property Canvas; |
||
473 | property Center: Boolean read FCenter write SetCenter; |
||
474 | property DIB: TDIB read FDIB write SetDIB; |
||
475 | property KeepAspect: Boolean read FKeepAspect write SetKeepAspect; |
||
476 | property Stretch: Boolean read FStretch write SetStretch; |
||
477 | property ViewWidth: Integer read FViewWidth write SetViewWidth; |
||
478 | property ViewHeight: Integer read FViewHeight write SetViewHeight; |
||
479 | end; |
||
480 | |||
481 | { TDXPaintBox } |
||
482 | |||
483 | TDXPaintBox = class(TCustomDXPaintBox) |
||
484 | published |
||
4 | daniel-mar | 485 | {$IFDEF VER4UP}property Anchors; {$ENDIF} |
1 | daniel-mar | 486 | property AutoStretch; |
487 | property Center; |
||
4 | daniel-mar | 488 | {$IFDEF VER4UP}property Constraints; {$ENDIF} |
1 | daniel-mar | 489 | property DIB; |
490 | property KeepAspect; |
||
491 | property Stretch; |
||
492 | property ViewWidth; |
||
493 | property ViewHeight; |
||
494 | |||
495 | property Align; |
||
496 | property DragCursor; |
||
497 | property DragMode; |
||
498 | property Enabled; |
||
499 | property ParentShowHint; |
||
500 | property PopupMenu; |
||
501 | property ShowHint; |
||
502 | property Visible; |
||
503 | property OnClick; |
||
504 | property OnDblClick; |
||
505 | property OnDragDrop; |
||
506 | property OnDragOver; |
||
507 | property OnEndDrag; |
||
508 | property OnMouseDown; |
||
509 | property OnMouseMove; |
||
510 | property OnMouseUp; |
||
4 | daniel-mar | 511 | {$IFDEF VER9UP}property OnMouseWheel; {$ENDIF} |
512 | {$IFDEF VER9UP}property OnResize; {$ENDIF} |
||
513 | {$IFDEF VER9UP}property OnCanResize; {$ENDIF} |
||
514 | {$IFDEF VER9UP}property OnContextPopup; {$ENDIF} |
||
1 | daniel-mar | 515 | property OnStartDrag; |
516 | end; |
||
517 | |||
4 | daniel-mar | 518 | const |
519 | DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2); |
||
1 | daniel-mar | 520 | |
4 | daniel-mar | 521 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
522 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF} |
||
523 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF} |
||
524 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF} |
||
525 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
||
526 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
||
527 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF} |
||
528 | |||
1 | daniel-mar | 529 | function GreyscaleColorTable: TRGBQuads; |
530 | |||
4 | daniel-mar | 531 | function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
532 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF} |
||
533 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF} |
||
534 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF} |
||
535 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF} |
||
1 | daniel-mar | 536 | |
4 | daniel-mar | 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} |
||
568 | |||
1 | daniel-mar | 569 | implementation |
570 | |||
4 | daniel-mar | 571 | uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg; |
1 | daniel-mar | 572 | |
4 | daniel-mar | 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} |
||
1 | daniel-mar | 589 | function Max(B1, B2: Integer): Integer; |
590 | begin |
||
4 | daniel-mar | 591 | if B1 >= B2 then Result := B1 else Result := B2; |
1 | daniel-mar | 592 | end; |
593 | |||
4 | daniel-mar | 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); |
||
608 | end; |
||
609 | |||
1 | daniel-mar | 610 | function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; |
611 | begin |
||
4 | daniel-mar | 612 | Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount); |
613 | Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount); |
||
614 | Result.BBitMask := (1 shl BBitCount) - 1; |
||
1 | daniel-mar | 615 | Result.RBitCount := RBitCount; |
616 | Result.GBitCount := GBitCount; |
||
617 | Result.BBitCount := BBitCount; |
||
4 | daniel-mar | 618 | Result.RBitCount2 := 8 - RBitCount; |
619 | Result.GBitCount2 := 8 - GBitCount; |
||
620 | Result.BBitCount2 := 8 - BBitCount; |
||
621 | Result.RShift := (GBitCount + BBitCount) - (8 - RBitCount); |
||
622 | Result.GShift := BBitCount - (8 - GBitCount); |
||
623 | Result.BShift := 8 - BBitCount; |
||
1 | daniel-mar | 624 | end; |
625 | |||
4 | daniel-mar | 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); |
||
1 | daniel-mar | 632 | |
4 | daniel-mar | 633 | Result := 0; |
634 | while ((1 shl i) and b) <> 0 do |
||
1 | daniel-mar | 635 | begin |
4 | daniel-mar | 636 | Inc(i); |
637 | Inc(Result); |
||
1 | daniel-mar | 638 | end; |
4 | daniel-mar | 639 | end; |
1 | daniel-mar | 640 | |
4 | daniel-mar | 641 | function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; |
1 | daniel-mar | 642 | begin |
643 | Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask), |
||
644 | GetBitCount(BBitMask)); |
||
645 | end; |
||
646 | |||
647 | function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; |
||
648 | begin |
||
649 | with PixelFormat do |
||
650 | Result := ((R shl RShift) and RBitMask) or ((G shl GShift) and GBitMask) or |
||
651 | ((B shr BShift) and BBitMask); |
||
652 | end; |
||
653 | |||
654 | procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); |
||
655 | begin |
||
656 | with PixelFormat do |
||
657 | begin |
||
658 | R := (Color and RBitMask) shr RShift; |
||
659 | R := R or (R shr RBitCount2); |
||
660 | G := (Color and GBitMask) shr GShift; |
||
661 | G := G or (G shr GBitCount2); |
||
662 | B := (Color and BBitMask) shl BShift; |
||
663 | B := B or (B shr BBitCount2); |
||
664 | end; |
||
665 | end; |
||
666 | |||
667 | function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
668 | begin |
||
669 | with PixelFormat do |
||
670 | begin |
||
671 | Result := (Color and RBitMask) shr RShift; |
||
4 | daniel-mar | 672 | Result := Result or (Result shr RBitCount2); |
1 | daniel-mar | 673 | end; |
674 | end; |
||
675 | |||
676 | function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
677 | begin |
||
678 | with PixelFormat do |
||
679 | begin |
||
680 | Result := (Color and GBitMask) shr GShift; |
||
4 | daniel-mar | 681 | Result := Result or (Result shr GBitCount2); |
1 | daniel-mar | 682 | end; |
683 | end; |
||
684 | |||
685 | function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; |
||
686 | begin |
||
687 | with PixelFormat do |
||
688 | begin |
||
689 | Result := (Color and BBitMask) shl BShift; |
||
4 | daniel-mar | 690 | Result := Result or (Result shr BBitCount2); |
1 | daniel-mar | 691 | end; |
692 | end; |
||
693 | |||
694 | function GreyscaleColorTable: TRGBQuads; |
||
695 | var |
||
696 | i: Integer; |
||
697 | begin |
||
4 | daniel-mar | 698 | for i := 0 to 255 do |
1 | daniel-mar | 699 | with Result[i] do |
700 | begin |
||
701 | rgbRed := i; |
||
702 | rgbGreen := i; |
||
703 | rgbBlue := i; |
||
704 | rgbReserved := 0; |
||
705 | end; |
||
706 | end; |
||
707 | |||
708 | function RGBQuad(R, G, B: Byte): TRGBQuad; |
||
709 | begin |
||
710 | with Result do |
||
711 | begin |
||
712 | rgbRed := R; |
||
713 | rgbGreen := G; |
||
714 | rgbBlue := B; |
||
715 | rgbReserved := 0; |
||
716 | end; |
||
717 | end; |
||
718 | |||
719 | function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; |
||
720 | begin |
||
721 | with Result do |
||
722 | with Entry do |
||
723 | begin |
||
724 | rgbRed := peRed; |
||
725 | rgbGreen := peGreen; |
||
726 | rgbBlue := peBlue; |
||
727 | rgbReserved := 0; |
||
728 | end; |
||
729 | end; |
||
730 | |||
731 | function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; |
||
732 | var |
||
733 | i: Integer; |
||
734 | begin |
||
4 | daniel-mar | 735 | for i := 0 to 255 do |
1 | daniel-mar | 736 | Result[i] := PaletteEntryToRGBQuad(Entries[i]); |
737 | end; |
||
738 | |||
739 | function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; |
||
740 | begin |
||
741 | with Result do |
||
742 | with RGBQuad do |
||
743 | begin |
||
744 | peRed := rgbRed; |
||
745 | peGreen := rgbGreen; |
||
746 | peBlue := rgbBlue; |
||
747 | peFlags := 0; |
||
748 | end; |
||
749 | end; |
||
750 | |||
751 | function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; |
||
752 | var |
||
753 | i: Integer; |
||
754 | begin |
||
4 | daniel-mar | 755 | for i := 0 to 255 do |
1 | daniel-mar | 756 | Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]); |
757 | end; |
||
758 | |||
759 | { TDIBSharedImage } |
||
760 | |||
761 | type |
||
762 | PLocalDIBPixelFormat = ^TLocalDIBPixelFormat; |
||
763 | TLocalDIBPixelFormat = packed record |
||
764 | RBitMask, GBitMask, BBitMask: DWORD; |
||
765 | end; |
||
766 | |||
4 | daniel-mar | 767 | { TPaletteItem } |
768 | |||
1 | daniel-mar | 769 | TPaletteItem = class(TCollectionItem) |
770 | private |
||
771 | ID: Integer; |
||
772 | Palette: HPalette; |
||
773 | RefCount: Integer; |
||
774 | ColorTable: TRGBQuads; |
||
775 | ColorTableCount: Integer; |
||
776 | destructor Destroy; override; |
||
777 | procedure AddRef; |
||
4 | daniel-mar | 778 | procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF} |
1 | daniel-mar | 779 | end; |
780 | |||
4 | daniel-mar | 781 | { TPaletteManager } |
782 | |||
1 | daniel-mar | 783 | TPaletteManager = class |
784 | private |
||
785 | FList: TCollection; |
||
786 | constructor Create; |
||
787 | destructor Destroy; override; |
||
788 | function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
||
789 | procedure DeletePalette(var Palette: HPalette); |
||
790 | end; |
||
791 | |||
4 | daniel-mar | 792 | { TPaletteItem } |
793 | |||
1 | daniel-mar | 794 | destructor TPaletteItem.Destroy; |
795 | begin |
||
796 | DeleteObject(Palette); |
||
797 | inherited Destroy; |
||
798 | end; |
||
799 | |||
800 | procedure TPaletteItem.AddRef; |
||
801 | begin |
||
802 | Inc(RefCount); |
||
803 | end; |
||
804 | |||
805 | procedure TPaletteItem.Release; |
||
806 | begin |
||
807 | Dec(RefCount); |
||
4 | daniel-mar | 808 | if RefCount <= 0 then Free; |
1 | daniel-mar | 809 | end; |
810 | |||
4 | daniel-mar | 811 | { TPaletteManager } |
812 | |||
1 | daniel-mar | 813 | constructor TPaletteManager.Create; |
814 | begin |
||
815 | inherited Create; |
||
816 | FList := TCollection.Create(TPaletteItem); |
||
817 | end; |
||
818 | |||
819 | destructor TPaletteManager.Destroy; |
||
820 | begin |
||
821 | FList.Free; |
||
822 | inherited Destroy; |
||
823 | end; |
||
824 | |||
825 | function TPaletteManager.CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette; |
||
826 | type |
||
827 | TMyLogPalette = record |
||
828 | palVersion: Word; |
||
829 | palNumEntries: Word; |
||
830 | palPalEntry: TPaletteEntries; |
||
831 | end; |
||
832 | var |
||
833 | i, ID: Integer; |
||
834 | Item: TPaletteItem; |
||
835 | LogPalette: TMyLogPalette; |
||
836 | begin |
||
837 | { Hash key making } |
||
838 | ID := ColorTableCount; |
||
4 | daniel-mar | 839 | for i := 0 to ColorTableCount - 1 do |
1 | daniel-mar | 840 | with ColorTable[i] do |
841 | begin |
||
842 | Inc(ID, rgbRed); |
||
843 | Inc(ID, rgbGreen); |
||
844 | Inc(ID, rgbBlue); |
||
845 | end; |
||
846 | |||
847 | { Does the same palette already exist? } |
||
4 | daniel-mar | 848 | for i := 0 to FList.Count - 1 do |
1 | daniel-mar | 849 | begin |
850 | Item := TPaletteItem(FList.Items[i]); |
||
4 | daniel-mar | 851 | if (Item.ID = ID) and (Item.ColorTableCount = ColorTableCount) and |
852 | CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount * SizeOf(TRGBQuad)) then |
||
1 | daniel-mar | 853 | begin |
854 | Item.AddRef; Result := Item.Palette; |
||
855 | Exit; |
||
856 | end; |
||
857 | end; |
||
858 | |||
859 | { New palette making } |
||
860 | Item := TPaletteItem.Create(FList); |
||
861 | Item.ID := ID; |
||
4 | daniel-mar | 862 | Move(ColorTable, Item.ColorTable, ColorTableCount * SizeOf(TRGBQuad)); |
1 | daniel-mar | 863 | Item.ColorTableCount := ColorTableCount; |
864 | |||
865 | with LogPalette do |
||
866 | begin |
||
867 | palVersion := $300; |
||
868 | palNumEntries := ColorTableCount; |
||
869 | palPalEntry := RGBQuadsToPaletteEntries(ColorTable); |
||
870 | end; |
||
871 | |||
872 | Item.Palette := Windows.CreatePalette(PLogPalette(@LogPalette)^); |
||
873 | Item.AddRef; Result := Item.Palette; |
||
874 | end; |
||
875 | |||
876 | procedure TPaletteManager.DeletePalette(var Palette: HPalette); |
||
877 | var |
||
878 | i: Integer; |
||
879 | Item: TPaletteItem; |
||
880 | begin |
||
4 | daniel-mar | 881 | if Palette = 0 then Exit; |
1 | daniel-mar | 882 | |
4 | daniel-mar | 883 | for i := 0 to FList.Count - 1 do |
1 | daniel-mar | 884 | begin |
885 | Item := TPaletteItem(FList.Items[i]); |
||
4 | daniel-mar | 886 | if (Item.Palette = Palette) then |
1 | daniel-mar | 887 | begin |
888 | Palette := 0; |
||
889 | Item.Release; |
||
890 | Exit; |
||
891 | end; |
||
892 | end; |
||
893 | end; |
||
894 | |||
895 | var |
||
896 | FPaletteManager: TPaletteManager; |
||
897 | |||
898 | function PaletteManager: TPaletteManager; |
||
899 | begin |
||
4 | daniel-mar | 900 | if FPaletteManager = nil then |
1 | daniel-mar | 901 | FPaletteManager := TPaletteManager.Create; |
902 | Result := FPaletteManager; |
||
903 | end; |
||
904 | |||
4 | daniel-mar | 905 | { TDIBSharedImage } |
906 | |||
1 | daniel-mar | 907 | constructor TDIBSharedImage.Create; |
908 | begin |
||
909 | inherited Create; |
||
910 | FMemoryImage := True; |
||
911 | SetColorTable(GreyscaleColorTable); |
||
912 | FColorTable := GreyscaleColorTable; |
||
913 | FPixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
914 | end; |
||
915 | |||
916 | procedure TDIBSharedImage.NewImage(AWidth, AHeight, ABitCount: Integer; |
||
917 | const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean); |
||
918 | var |
||
919 | InfoOfs: Integer; |
||
920 | UsePixelFormat: Boolean; |
||
921 | begin |
||
4 | daniel-mar | 922 | {$IFNDEF D17UP} |
923 | {self recreation is not allowed here} |
||
1 | daniel-mar | 924 | Create; |
4 | daniel-mar | 925 | {$ENDIF} |
1 | daniel-mar | 926 | { Pixel format check } |
927 | case ABitCount of |
||
4 | daniel-mar | 928 | 1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
929 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
930 | 4: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
||
931 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
932 | 8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
||
933 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
934 | 16: |
||
935 | begin |
||
936 | if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or |
||
937 | ((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then |
||
938 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
939 | end; |
||
940 | 24: |
||
941 | begin |
||
942 | if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
||
943 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
944 | end; |
||
945 | 32: |
||
946 | begin |
||
947 | if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then |
||
948 | raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat); |
||
949 | end; |
||
1 | daniel-mar | 950 | else |
951 | raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]); |
||
952 | end; |
||
953 | |||
954 | FBitCount := ABitCount; |
||
955 | FHeight := AHeight; |
||
956 | FWidth := AWidth; |
||
4 | daniel-mar | 957 | FWidthBytes := (((AWidth * ABitCount) + 31) shr 5) * 4; |
1 | daniel-mar | 958 | FNextLine := -FWidthBytes; |
4 | daniel-mar | 959 | FSize := FWidthBytes * FHeight; |
1 | daniel-mar | 960 | UsePixelFormat := ABitCount in [16, 32]; |
961 | |||
962 | FPixelFormat := PixelFormat; |
||
963 | |||
964 | FPaletteCount := 0; |
||
4 | daniel-mar | 965 | if FBitCount <= 8 then |
1 | daniel-mar | 966 | FPaletteCount := 1 shl FBitCount; |
967 | |||
968 | FBitmapInfoSize := SizeOf(TBitmapInfoHeader); |
||
969 | if UsePixelFormat then |
||
970 | Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat)); |
||
4 | daniel-mar | 971 | Inc(FBitmapInfoSize, SizeOf(TRGBQuad) * FPaletteCount); |
1 | daniel-mar | 972 | |
973 | GetMem(FBitmapInfo, FBitmapInfoSize); |
||
974 | FillChar(FBitmapInfo^, FBitmapInfoSize, 0); |
||
975 | |||
976 | { BitmapInfo setting. } |
||
977 | with FBitmapInfo^.bmiHeader do |
||
978 | begin |
||
979 | biSize := SizeOf(TBitmapInfoHeader); |
||
980 | biWidth := FWidth; |
||
981 | biHeight := FHeight; |
||
982 | biPlanes := 1; |
||
983 | biBitCount := FBitCount; |
||
984 | if UsePixelFormat then |
||
985 | biCompression := BI_BITFIELDS |
||
986 | else |
||
987 | begin |
||
4 | daniel-mar | 988 | if (FBitCount = 4) and (Compressed) then |
1 | daniel-mar | 989 | biCompression := BI_RLE4 |
4 | daniel-mar | 990 | else if (FBitCount = 8) and (Compressed) then |
1 | daniel-mar | 991 | biCompression := BI_RLE8 |
992 | else |
||
993 | biCompression := BI_RGB; |
||
994 | end; |
||
995 | biSizeImage := FSize; |
||
996 | biXPelsPerMeter := 0; |
||
997 | biYPelsPerMeter := 0; |
||
998 | biClrUsed := 0; |
||
999 | biClrImportant := 0; |
||
1000 | end; |
||
1001 | InfoOfs := SizeOf(TBitmapInfoHeader); |
||
1002 | |||
1003 | if UsePixelFormat then |
||
1004 | begin |
||
4 | daniel-mar | 1005 | with PLocalDIBPixelFormat(Integer(FBitmapInfo) + InfoOfs)^ do |
1 | daniel-mar | 1006 | begin |
1007 | RBitMask := PixelFormat.RBitMask; |
||
1008 | GBitMask := PixelFormat.GBitMask; |
||
1009 | BBitMask := PixelFormat.BBitMask; |
||
1010 | end; |
||
1011 | |||
1012 | Inc(InfoOfs, SizeOf(TLocalDIBPixelFormat)); |
||
1013 | end; |
||
1014 | |||
1015 | FColorTablePos := InfoOfs; |
||
1016 | |||
1017 | FColorTable := ColorTable; |
||
4 | daniel-mar | 1018 | Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount); |
1 | daniel-mar | 1019 | |
1020 | FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8]; |
||
1021 | FMemoryImage := MemoryImage or FCompressed; |
||
1022 | |||
1023 | { DIB making. } |
||
1024 | if not Compressed then |
||
1025 | begin |
||
1026 | if MemoryImage then |
||
1027 | begin |
||
1028 | FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize)); |
||
4 | daniel-mar | 1029 | if FPBits = nil then |
1 | daniel-mar | 1030 | OutOfMemoryError; |
4 | daniel-mar | 1031 | end |
1032 | else |
||
1 | daniel-mar | 1033 | begin |
1034 | FDC := CreateCompatibleDC(0); |
||
1035 | |||
1036 | FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0); |
||
4 | daniel-mar | 1037 | if FHandle = 0 then |
1 | daniel-mar | 1038 | raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']); |
1039 | |||
1040 | FOldHandle := SelectObject(FDC, FHandle); |
||
1041 | end; |
||
1042 | end; |
||
1043 | |||
4 | daniel-mar | 1044 | FTopPBits := Pointer(Integer(FPBits) + (FHeight - 1) * FWidthBytes); |
1 | daniel-mar | 1045 | end; |
1046 | |||
1047 | procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
1048 | begin |
||
4 | daniel-mar | 1049 | if Source = nil then Exit; //no source |
1050 | |||
1051 | if Source.FSize = 0 then |
||
1 | daniel-mar | 1052 | begin |
4 | daniel-mar | 1053 | {$IFNDEF D17UP} |
1054 | {self recreation is not allowed here} |
||
1 | daniel-mar | 1055 | Create; |
4 | daniel-mar | 1056 | {$ENDIF} |
1 | daniel-mar | 1057 | FMemoryImage := MemoryImage; |
4 | daniel-mar | 1058 | end |
1059 | else |
||
1 | daniel-mar | 1060 | begin |
1061 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
||
1062 | Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed); |
||
1063 | if FCompressed then |
||
1064 | begin |
||
1065 | FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage; |
||
1066 | GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage); |
||
1067 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
||
4 | daniel-mar | 1068 | end |
1069 | else |
||
1 | daniel-mar | 1070 | begin |
1071 | Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage); |
||
1072 | end; |
||
1073 | end; |
||
1074 | end; |
||
1075 | |||
1076 | procedure TDIBSharedImage.Compress(Source: TDIBSharedImage); |
||
1077 | |||
1078 | procedure EncodeRLE4; |
||
1079 | var |
||
1080 | Size: Integer; |
||
1081 | |||
1082 | function AllocByte: PByte; |
||
1083 | begin |
||
4 | daniel-mar | 1084 | if Size mod 4096 = 0 then |
1085 | ReAllocMem(FPBits, Size + 4095); |
||
1086 | Result := Pointer(Integer(FPBits) + Size); |
||
1 | daniel-mar | 1087 | Inc(Size); |
1088 | end; |
||
1089 | |||
1090 | var |
||
1091 | B1, B2, C: Byte; |
||
1092 | PB1, PB2: Integer; |
||
1093 | Src: PByte; |
||
1094 | X, Y: Integer; |
||
1095 | |||
1096 | function GetPixel(x: Integer): Integer; |
||
1097 | begin |
||
4 | daniel-mar | 1098 | if X and 1 = 0 then |
1 | daniel-mar | 1099 | Result := PArrayByte(Src)[X shr 1] shr 4 |
1100 | else |
||
1101 | Result := PArrayByte(Src)[X shr 1] and $0F; |
||
1102 | end; |
||
1103 | |||
1104 | begin |
||
1105 | Size := 0; |
||
1106 | |||
4 | daniel-mar | 1107 | for y := 0 to Source.FHeight - 1 do |
1 | daniel-mar | 1108 | begin |
1109 | x := 0; |
||
4 | daniel-mar | 1110 | Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes); |
1111 | while x < Source.FWidth do |
||
1 | daniel-mar | 1112 | begin |
4 | daniel-mar | 1113 | if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) then |
1 | daniel-mar | 1114 | begin |
1115 | { Encoding mode } |
||
1116 | B1 := 2; |
||
4 | daniel-mar | 1117 | B2 := (GetPixel(x) shl 4) or GetPixel(x + 1); |
1 | daniel-mar | 1118 | |
1119 | Inc(x, 2); |
||
1120 | |||
1121 | C := B2; |
||
1122 | |||
4 | daniel-mar | 1123 | while (x < Source.FWidth) and (C and $F = GetPixel(x)) and (B1 < 255) do |
1 | daniel-mar | 1124 | begin |
1125 | Inc(B1); |
||
1126 | Inc(x); |
||
1127 | C := (C shr 4) or (C shl 4); |
||
1128 | end; |
||
1129 | |||
1130 | AllocByte^ := B1; |
||
1131 | AllocByte^ := B2; |
||
4 | daniel-mar | 1132 | end |
1133 | else |
||
1134 | if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and |
||
1135 | ((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then |
||
1136 | begin |
||
1 | daniel-mar | 1137 | { Encoding mode } |
4 | daniel-mar | 1138 | AllocByte^ := 2; |
1139 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
||
1140 | Inc(x, 2); |
||
1141 | end |
||
1142 | else |
||
1 | daniel-mar | 1143 | begin |
4 | daniel-mar | 1144 | if (Source.FWidth - x < 4) then |
1145 | begin |
||
1 | daniel-mar | 1146 | { Encoding mode } |
4 | daniel-mar | 1147 | while Source.FWidth - x >= 2 do |
1148 | begin |
||
1149 | AllocByte^ := 2; |
||
1150 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
||
1151 | Inc(x, 2); |
||
1152 | end; |
||
1 | daniel-mar | 1153 | |
4 | daniel-mar | 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 |
||
1 | daniel-mar | 1162 | begin |
1163 | { Absolute mode } |
||
4 | daniel-mar | 1164 | PB1 := Size; AllocByte; |
1165 | PB2 := Size; AllocByte; |
||
1 | daniel-mar | 1166 | |
4 | daniel-mar | 1167 | B1 := 0; |
1168 | B2 := 4; |
||
1 | daniel-mar | 1169 | |
4 | daniel-mar | 1170 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
1171 | AllocByte^ := (GetPixel(x + 2) shl 4) or GetPixel(x + 3); |
||
1 | daniel-mar | 1172 | |
4 | daniel-mar | 1173 | Inc(x, 4); |
1 | daniel-mar | 1174 | |
4 | daniel-mar | 1175 | while (x + 1 < Source.FWidth) and (B2 < 254) do |
1176 | begin |
||
1177 | if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) and (GetPixel(x + 1) = GetPixel(x + 3)) then |
||
1178 | Break; |
||
1 | daniel-mar | 1179 | |
4 | daniel-mar | 1180 | AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1); |
1181 | Inc(B2, 2); |
||
1182 | Inc(x, 2); |
||
1183 | end; |
||
1184 | |||
1185 | PByte(Integer(FPBits) + PB1)^ := B1; |
||
1186 | PByte(Integer(FPBits) + PB2)^ := B2; |
||
1 | daniel-mar | 1187 | end; |
1188 | end; |
||
1189 | |||
4 | daniel-mar | 1190 | if Size and 1 = 1 then AllocByte; |
1 | daniel-mar | 1191 | end; |
1192 | |||
1193 | { End of line } |
||
1194 | AllocByte^ := 0; |
||
1195 | AllocByte^ := 0; |
||
1196 | end; |
||
1197 | |||
1198 | { End of bitmap } |
||
1199 | AllocByte^ := 0; |
||
1200 | AllocByte^ := 1; |
||
1201 | |||
1202 | FBitmapInfo.bmiHeader.biSizeImage := Size; |
||
1203 | FSize := Size; |
||
1204 | end; |
||
1205 | |||
1206 | procedure EncodeRLE8; |
||
1207 | var |
||
1208 | Size: Integer; |
||
1209 | |||
1210 | function AllocByte: PByte; |
||
1211 | begin |
||
4 | daniel-mar | 1212 | if Size mod 4096 = 0 then |
1213 | ReAllocMem(FPBits, Size + 4095); |
||
1214 | Result := Pointer(Integer(FPBits) + Size); |
||
1 | daniel-mar | 1215 | Inc(Size); |
1216 | end; |
||
1217 | |||
1218 | var |
||
1219 | B1, B2: Byte; |
||
1220 | PB1, PB2: Integer; |
||
1221 | Src: PByte; |
||
1222 | X, Y: Integer; |
||
1223 | begin |
||
1224 | Size := 0; |
||
1225 | |||
4 | daniel-mar | 1226 | for y := 0 to Source.FHeight - 1 do |
1 | daniel-mar | 1227 | begin |
1228 | x := 0; |
||
4 | daniel-mar | 1229 | Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes); |
1230 | while x < Source.FWidth do |
||
1 | daniel-mar | 1231 | begin |
4 | daniel-mar | 1232 | if (Source.FWidth - x > 2) and (Src^ = PByte(Integer(Src) + 1)^) then |
1 | daniel-mar | 1233 | begin |
1234 | { Encoding mode } |
||
1235 | B1 := 2; |
||
1236 | B2 := Src^; |
||
1237 | |||
1238 | Inc(x, 2); |
||
1239 | Inc(Src, 2); |
||
1240 | |||
4 | daniel-mar | 1241 | while (x < Source.FWidth) and (Src^ = B2) and (B1 < 255) do |
1 | daniel-mar | 1242 | begin |
1243 | Inc(B1); |
||
1244 | Inc(x); |
||
1245 | Inc(Src); |
||
1246 | end; |
||
1247 | |||
1248 | AllocByte^ := B1; |
||
1249 | AllocByte^ := B2; |
||
4 | daniel-mar | 1250 | end |
1251 | else |
||
1252 | if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then |
||
1253 | begin |
||
1 | daniel-mar | 1254 | { Encoding mode } |
4 | daniel-mar | 1255 | AllocByte^ := 1; |
1256 | AllocByte^ := Src^; Inc(Src); |
||
1257 | Inc(x); |
||
1258 | end |
||
1259 | else |
||
1 | daniel-mar | 1260 | begin |
4 | daniel-mar | 1261 | if (Source.FWidth - x < 4) then |
1262 | begin |
||
1 | daniel-mar | 1263 | { Encoding mode } |
4 | daniel-mar | 1264 | if Source.FWidth - x = 2 then |
1265 | begin |
||
1266 | AllocByte^ := 1; |
||
1267 | AllocByte^ := Src^; Inc(Src); |
||
1 | daniel-mar | 1268 | |
4 | daniel-mar | 1269 | AllocByte^ := 1; |
1270 | AllocByte^ := Src^; Inc(Src); |
||
1271 | Inc(x, 2); |
||
1272 | end |
||
1273 | else |
||
1274 | begin |
||
1275 | AllocByte^ := 1; |
||
1276 | AllocByte^ := Src^; Inc(Src); |
||
1277 | Inc(x); |
||
1278 | end; |
||
1279 | end |
||
1280 | else |
||
1 | daniel-mar | 1281 | begin |
1282 | { Absolute mode } |
||
4 | daniel-mar | 1283 | PB1 := Size; AllocByte; |
1284 | PB2 := Size; AllocByte; |
||
1 | daniel-mar | 1285 | |
4 | daniel-mar | 1286 | B1 := 0; |
1287 | B2 := 3; |
||
1 | daniel-mar | 1288 | |
4 | daniel-mar | 1289 | Inc(x, 3); |
1 | daniel-mar | 1290 | |
4 | daniel-mar | 1291 | AllocByte^ := Src^; Inc(Src); |
1292 | AllocByte^ := Src^; Inc(Src); |
||
1293 | AllocByte^ := Src^; Inc(Src); |
||
1 | daniel-mar | 1294 | |
4 | daniel-mar | 1295 | while (x < Source.FWidth) and (B2 < 255) do |
1296 | begin |
||
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 |
||
1298 | Break; |
||
1 | daniel-mar | 1299 | |
4 | daniel-mar | 1300 | AllocByte^ := Src^; Inc(Src); |
1301 | Inc(B2); |
||
1302 | Inc(x); |
||
1303 | end; |
||
1304 | |||
1305 | PByte(Integer(FPBits) + PB1)^ := B1; |
||
1306 | PByte(Integer(FPBits) + PB2)^ := B2; |
||
1 | daniel-mar | 1307 | end; |
1308 | end; |
||
1309 | |||
4 | daniel-mar | 1310 | if Size and 1 = 1 then AllocByte; |
1 | daniel-mar | 1311 | end; |
1312 | |||
1313 | { End of line } |
||
1314 | AllocByte^ := 0; |
||
1315 | AllocByte^ := 0; |
||
1316 | end; |
||
1317 | |||
1318 | { End of bitmap } |
||
1319 | AllocByte^ := 0; |
||
1320 | AllocByte^ := 1; |
||
1321 | |||
1322 | FBitmapInfo.bmiHeader.biSizeImage := Size; |
||
1323 | FSize := Size; |
||
1324 | end; |
||
1325 | |||
1326 | begin |
||
1327 | if Source.FCompressed then |
||
1328 | Duplicate(Source, Source.FMemoryImage) |
||
4 | daniel-mar | 1329 | else |
1330 | begin |
||
1 | daniel-mar | 1331 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
1332 | Source.FPixelFormat, Source.FColorTable, True, True); |
||
1333 | case FBitmapInfo.bmiHeader.biCompression of |
||
1334 | BI_RLE4: EncodeRLE4; |
||
1335 | BI_RLE8: EncodeRLE8; |
||
1336 | else |
||
1337 | Duplicate(Source, Source.FMemoryImage); |
||
1338 | end; |
||
1339 | end; |
||
1340 | end; |
||
1341 | |||
1342 | procedure TDIBSharedImage.Decompress(Source: TDIBSharedImage; MemoryImage: Boolean); |
||
1343 | |||
1344 | procedure DecodeRLE4; |
||
1345 | var |
||
1346 | B1, B2, C: Byte; |
||
1347 | Dest, Src, P: PByte; |
||
1348 | X, Y, i: Integer; |
||
1349 | begin |
||
1350 | Src := Source.FPBits; |
||
1351 | X := 0; |
||
1352 | Y := 0; |
||
1353 | |||
1354 | while True do |
||
1355 | begin |
||
1356 | B1 := Src^; Inc(Src); |
||
1357 | B2 := Src^; Inc(Src); |
||
1358 | |||
4 | daniel-mar | 1359 | if B1 = 0 then |
1 | daniel-mar | 1360 | begin |
1361 | case B2 of |
||
4 | daniel-mar | 1362 | 0: begin { End of line } |
1363 | X := 0; |
||
1364 | Inc(Y); |
||
1365 | end; |
||
1 | daniel-mar | 1366 | 1: Break; { End of bitmap } |
4 | daniel-mar | 1367 | 2: begin { Difference of coordinates } |
1368 | Inc(X, B1); |
||
1369 | Inc(Y, B2); Inc(Src, 2); |
||
1370 | end; |
||
1 | daniel-mar | 1371 | else |
1372 | { Absolute mode } |
||
4 | daniel-mar | 1373 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes); |
1 | daniel-mar | 1374 | |
1375 | C := 0; |
||
4 | daniel-mar | 1376 | for i := 0 to B2 - 1 do |
1 | daniel-mar | 1377 | begin |
4 | daniel-mar | 1378 | if i and 1 = 0 then |
1 | daniel-mar | 1379 | begin |
1380 | C := Src^; Inc(Src); |
||
4 | daniel-mar | 1381 | end |
1382 | else |
||
1 | daniel-mar | 1383 | begin |
1384 | C := C shl 4; |
||
1385 | end; |
||
1386 | |||
4 | daniel-mar | 1387 | P := Pointer(Integer(Dest) + X shr 1); |
1388 | if X and 1 = 0 then |
||
1 | daniel-mar | 1389 | P^ := (P^ and $0F) or (C and $F0) |
1390 | else |
||
1391 | P^ := (P^ and $F0) or ((C and $F0) shr 4); |
||
1392 | |||
1393 | Inc(X); |
||
1394 | end; |
||
1395 | end; |
||
4 | daniel-mar | 1396 | end |
1397 | else |
||
1 | daniel-mar | 1398 | begin |
1399 | { Encoding mode } |
||
4 | daniel-mar | 1400 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes); |
1 | daniel-mar | 1401 | |
4 | daniel-mar | 1402 | for i := 0 to B1 - 1 do |
1 | daniel-mar | 1403 | begin |
4 | daniel-mar | 1404 | P := Pointer(Integer(Dest) + X shr 1); |
1405 | if X and 1 = 0 then |
||
1 | daniel-mar | 1406 | P^ := (P^ and $0F) or (B2 and $F0) |
1407 | else |
||
1408 | P^ := (P^ and $F0) or ((B2 and $F0) shr 4); |
||
1409 | |||
1410 | Inc(X); |
||
1411 | |||
1412 | // Swap nibble |
||
1413 | B2 := (B2 shr 4) or (B2 shl 4); |
||
1414 | end; |
||
1415 | end; |
||
1416 | |||
1417 | { Word arrangement } |
||
1418 | Inc(Src, Longint(Src) and 1); |
||
1419 | end; |
||
1420 | end; |
||
1421 | |||
1422 | procedure DecodeRLE8; |
||
1423 | var |
||
1424 | B1, B2: Byte; |
||
1425 | Dest, Src: PByte; |
||
1426 | X, Y: Integer; |
||
1427 | begin |
||
1428 | Dest := FPBits; |
||
1429 | Src := Source.FPBits; |
||
1430 | X := 0; |
||
1431 | Y := 0; |
||
1432 | |||
1433 | while True do |
||
1434 | begin |
||
1435 | B1 := Src^; Inc(Src); |
||
1436 | B2 := Src^; Inc(Src); |
||
1437 | |||
4 | daniel-mar | 1438 | if B1 = 0 then |
1 | daniel-mar | 1439 | begin |
1440 | case B2 of |
||
4 | daniel-mar | 1441 | 0: begin { End of line } |
1442 | X := 0; Inc(Y); |
||
1443 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X); |
||
1444 | end; |
||
1 | daniel-mar | 1445 | 1: Break; { End of bitmap } |
4 | daniel-mar | 1446 | 2: begin { Difference of coordinates } |
1447 | Inc(X, B1); Inc(Y, B2); Inc(Src, 2); |
||
1448 | Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X); |
||
1449 | end; |
||
1 | daniel-mar | 1450 | else |
1451 | { Absolute mode } |
||
1452 | Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2); |
||
1453 | end; |
||
4 | daniel-mar | 1454 | end |
1455 | else |
||
1 | daniel-mar | 1456 | begin |
1457 | { Encoding mode } |
||
1458 | FillChar(Dest^, B1, B2); Inc(Dest, B1); |
||
1459 | end; |
||
1460 | |||
1461 | { Word arrangement } |
||
1462 | Inc(Src, Longint(Src) and 1); |
||
1463 | end; |
||
1464 | end; |
||
1465 | |||
1466 | begin |
||
1467 | if not Source.FCompressed then |
||
1468 | Duplicate(Source, MemoryImage) |
||
4 | daniel-mar | 1469 | else |
1470 | begin |
||
1 | daniel-mar | 1471 | NewImage(Source.FWidth, Source.FHeight, Source.FBitCount, |
1472 | Source.FPixelFormat, Source.FColorTable, MemoryImage, False); |
||
1473 | case Source.FBitmapInfo.bmiHeader.biCompression of |
||
1474 | BI_RLE4: DecodeRLE4; |
||
1475 | BI_RLE8: DecodeRLE8; |
||
1476 | else |
||
1477 | Duplicate(Source, MemoryImage); |
||
4 | daniel-mar | 1478 | end; |
1 | daniel-mar | 1479 | end; |
1480 | end; |
||
1481 | |||
1482 | procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean); |
||
1483 | var |
||
1484 | BI: TBitmapInfoHeader; |
||
1485 | BC: TBitmapCoreHeader; |
||
1486 | BCRGB: array[0..255] of TRGBTriple; |
||
1487 | |||
1488 | procedure LoadRLE4; |
||
1489 | begin |
||
1490 | FSize := BI.biSizeImage; |
||
4 | daniel-mar | 1491 | //GetMem(FPBits, FSize); |
1 | daniel-mar | 1492 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
1493 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
||
1494 | Stream.ReadBuffer(FPBits^, FSize); |
||
1495 | end; |
||
1496 | |||
1497 | procedure LoadRLE8; |
||
1498 | begin |
||
1499 | FSize := BI.biSizeImage; |
||
4 | daniel-mar | 1500 | //GetMem(FPBits, FSize); |
1 | daniel-mar | 1501 | FPBits := GlobalAllocPtr(GMEM_FIXED, FSize); |
1502 | FBitmapInfo.bmiHeader.biSizeImage := FSize; |
||
1503 | Stream.ReadBuffer(FPBits^, FSize); |
||
1504 | end; |
||
1505 | |||
1506 | procedure LoadRGB; |
||
1507 | var |
||
1508 | y: Integer; |
||
1509 | begin |
||
4 | daniel-mar | 1510 | if BI.biHeight < 0 then |
1 | daniel-mar | 1511 | begin |
4 | daniel-mar | 1512 | for y := 0 to Abs(BI.biHeight) - 1 do |
1513 | Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes); |
||
1514 | end |
||
1515 | else |
||
1 | daniel-mar | 1516 | begin |
1517 | Stream.ReadBuffer(FPBits^, FSize); |
||
1518 | end; |
||
1519 | end; |
||
1520 | |||
1521 | var |
||
1522 | i, PalCount: Integer; |
||
1523 | OS2: Boolean; |
||
1524 | Localpf: TLocalDIBPixelFormat; |
||
1525 | AColorTable: TRGBQuads; |
||
1526 | APixelFormat: TDIBPixelFormat; |
||
1527 | begin |
||
4 | daniel-mar | 1528 | if not Assigned(Stream) then Exit; |
1529 | |||
1 | daniel-mar | 1530 | { Header size reading } |
1531 | i := Stream.Read(BI.biSize, 4); |
||
1532 | |||
4 | daniel-mar | 1533 | if i = 0 then |
1 | daniel-mar | 1534 | begin |
4 | daniel-mar | 1535 | {$IFNDEF D17UP} |
1536 | {self recreation is not allowed here} |
||
1 | daniel-mar | 1537 | Create; |
4 | daniel-mar | 1538 | {$ENDIF} |
1 | daniel-mar | 1539 | Exit; |
1540 | end; |
||
4 | daniel-mar | 1541 | if i <> 4 then |
1 | daniel-mar | 1542 | raise EInvalidGraphic.Create(SInvalidDIB); |
1543 | |||
1544 | { Kind check of DIB } |
||
1545 | OS2 := False; |
||
1546 | |||
1547 | case BI.biSize of |
||
1548 | SizeOf(TBitmapCoreHeader): |
||
1549 | begin |
||
1550 | { OS/2 type } |
||
4 | daniel-mar | 1551 | Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4); |
1 | daniel-mar | 1552 | |
1553 | with BI do |
||
1554 | begin |
||
1555 | biClrUsed := 0; |
||
1556 | biCompression := BI_RGB; |
||
1557 | biBitCount := BC.bcBitCount; |
||
1558 | biHeight := BC.bcHeight; |
||
1559 | biWidth := BC.bcWidth; |
||
1560 | end; |
||
1561 | |||
1562 | OS2 := True; |
||
1563 | end; |
||
1564 | SizeOf(TBitmapInfoHeader): |
||
1565 | begin |
||
1566 | { Windows type } |
||
4 | daniel-mar | 1567 | Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4); |
1 | daniel-mar | 1568 | end; |
1569 | else |
||
1570 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1571 | end; |
||
1572 | |||
1573 | { Bit mask reading. } |
||
1574 | if BI.biCompression = BI_BITFIELDS then |
||
1575 | begin |
||
1576 | Stream.ReadBuffer(Localpf, SizeOf(Localpf)); |
||
1577 | with Localpf do |
||
1578 | APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask); |
||
4 | daniel-mar | 1579 | end |
1580 | else |
||
1 | daniel-mar | 1581 | begin |
4 | daniel-mar | 1582 | if BI.biBitCount = 16 then |
1 | daniel-mar | 1583 | APixelFormat := MakeDIBPixelFormat(5, 5, 5) |
4 | daniel-mar | 1584 | else if BI.biBitCount = 32 then |
1 | daniel-mar | 1585 | APixelFormat := MakeDIBPixelFormat(8, 8, 8) |
1586 | else |
||
1587 | APixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1588 | end; |
||
1589 | |||
1590 | { Palette reading } |
||
1591 | PalCount := BI.biClrUsed; |
||
4 | daniel-mar | 1592 | if (PalCount = 0) and (BI.biBitCount <= 8) then |
1 | daniel-mar | 1593 | PalCount := 1 shl BI.biBitCount; |
4 | daniel-mar | 1594 | if PalCount > 256 then PalCount := 256; |
1 | daniel-mar | 1595 | |
1596 | FillChar(AColorTable, SizeOf(AColorTable), 0); |
||
1597 | |||
1598 | if OS2 then |
||
1599 | begin |
||
1600 | { OS/2 type } |
||
4 | daniel-mar | 1601 | Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple) * PalCount); |
1602 | for i := 0 to PalCount - 1 do |
||
1 | daniel-mar | 1603 | begin |
1604 | with BCRGB[i] do |
||
1605 | AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue); |
||
1606 | end; |
||
4 | daniel-mar | 1607 | end |
1608 | else |
||
1 | daniel-mar | 1609 | begin |
1610 | { Windows type } |
||
4 | daniel-mar | 1611 | Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount); |
1 | daniel-mar | 1612 | end; |
1613 | |||
4 | daniel-mar | 1614 | { DIB compilation } |
1 | daniel-mar | 1615 | NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable, |
1616 | MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]); |
||
1617 | |||
1618 | { Pixel data reading } |
||
1619 | case BI.biCompression of |
||
4 | daniel-mar | 1620 | BI_RGB: LoadRGB; |
1621 | BI_RLE4: LoadRLE4; |
||
1622 | BI_RLE8: LoadRLE8; |
||
1 | daniel-mar | 1623 | BI_BITFIELDS: LoadRGB; |
1624 | else |
||
1625 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1626 | end; |
||
1627 | end; |
||
1628 | |||
1629 | destructor TDIBSharedImage.Destroy; |
||
1630 | begin |
||
4 | daniel-mar | 1631 | if FHandle <> 0 then |
1 | daniel-mar | 1632 | begin |
4 | daniel-mar | 1633 | if FOldHandle <> 0 then SelectObject(FDC, FOldHandle); |
1 | daniel-mar | 1634 | DeleteObject(FHandle); |
4 | daniel-mar | 1635 | end |
1636 | else |
||
1637 | // GlobalFree(THandle(FPBits)); |
||
1 | daniel-mar | 1638 | begin |
4 | daniel-mar | 1639 | if FPBits <> nil then |
1 | daniel-mar | 1640 | GlobalFreePtr(FPBits); |
1641 | end; |
||
1642 | |||
1643 | PaletteManager.DeletePalette(FPalette); |
||
4 | daniel-mar | 1644 | if FDC <> 0 then DeleteDC(FDC); |
1 | daniel-mar | 1645 | |
1646 | FreeMem(FBitmapInfo); |
||
1647 | inherited Destroy; |
||
1648 | end; |
||
1649 | |||
1650 | procedure TDIBSharedImage.FreeHandle; |
||
1651 | begin |
||
1652 | end; |
||
1653 | |||
1654 | function TDIBSharedImage.GetPalette: THandle; |
||
1655 | begin |
||
4 | daniel-mar | 1656 | if FPaletteCount > 0 then |
1 | daniel-mar | 1657 | begin |
1658 | if FChangePalette then |
||
1659 | begin |
||
1660 | FChangePalette := False; |
||
1661 | PaletteManager.DeletePalette(FPalette); |
||
1662 | FPalette := PaletteManager.CreatePalette(FColorTable, FPaletteCount); |
||
1663 | end; |
||
1664 | Result := FPalette; |
||
1665 | end else |
||
1666 | Result := 0; |
||
1667 | end; |
||
1668 | |||
1669 | procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads); |
||
1670 | begin |
||
1671 | FColorTable := Value; |
||
1672 | FChangePalette := True; |
||
1673 | |||
4 | daniel-mar | 1674 | if (FSize > 0) and (FPaletteCount > 0) then |
1 | daniel-mar | 1675 | begin |
1676 | SetDIBColorTable(FDC, 0, 256, FColorTable); |
||
4 | daniel-mar | 1677 | Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount); |
1 | daniel-mar | 1678 | end; |
1679 | end; |
||
1680 | |||
1681 | { TDIB } |
||
1682 | |||
1683 | var |
||
1684 | FEmptyDIBImage: TDIBSharedImage; |
||
1685 | |||
1686 | function EmptyDIBImage: TDIBSharedImage; |
||
1687 | begin |
||
4 | daniel-mar | 1688 | if FEmptyDIBImage = nil then |
1 | daniel-mar | 1689 | begin |
1690 | FEmptyDIBImage := TDIBSharedImage.Create; |
||
1691 | FEmptyDIBImage.Reference; |
||
1692 | end; |
||
1693 | Result := FEmptyDIBImage; |
||
1694 | end; |
||
1695 | |||
1696 | constructor TDIB.Create; |
||
1697 | begin |
||
1698 | inherited Create; |
||
1699 | SetImage(EmptyDIBImage); |
||
4 | daniel-mar | 1700 | |
1701 | FFreeList := TList.Create; |
||
1 | daniel-mar | 1702 | end; |
1703 | |||
1704 | destructor TDIB.Destroy; |
||
4 | daniel-mar | 1705 | var |
1706 | D: TDIB; |
||
1 | daniel-mar | 1707 | begin |
1708 | SetImage(EmptyDIBImage); |
||
1709 | FCanvas.Free; |
||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 1720 | inherited Destroy; |
1721 | end; |
||
1722 | |||
1723 | procedure TDIB.Assign(Source: TPersistent); |
||
1724 | |||
1725 | procedure AssignBitmap(Source: TBitmap); |
||
1726 | var |
||
1727 | Data: array[0..1023] of Byte; |
||
1728 | BitmapRec: Windows.PBitmap; |
||
1729 | DIBSectionRec: PDIBSection; |
||
1730 | PaletteEntries: TPaletteEntries; |
||
1731 | begin |
||
1732 | GetPaletteEntries(Source.Palette, 0, 256, PaletteEntries); |
||
1733 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
||
1734 | UpdatePalette; |
||
1735 | |||
1736 | case GetObject(Source.Handle, SizeOf(Data), @Data) of |
||
1737 | SizeOf(Windows.TBitmap): |
||
4 | daniel-mar | 1738 | begin |
1739 | BitmapRec := @Data; |
||
1740 | case BitmapRec^.bmBitsPixel of |
||
1741 | 16: PixelFormat := MakeDIBPixelFormat(5, 5, 5); |
||
1742 | else |
||
1743 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1 | daniel-mar | 1744 | end; |
4 | daniel-mar | 1745 | SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel); |
1746 | end; |
||
1 | daniel-mar | 1747 | SizeOf(TDIBSection): |
4 | daniel-mar | 1748 | begin |
1749 | DIBSectionRec := @Data; |
||
1750 | if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then |
||
1 | daniel-mar | 1751 | begin |
4 | daniel-mar | 1752 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
1753 | end |
||
1754 | else |
||
1755 | if DIBSectionRec^.dsBm.bmBitsPixel > 8 then |
||
1 | daniel-mar | 1756 | begin |
4 | daniel-mar | 1757 | PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks |
1 | daniel-mar | 1758 | DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]); |
4 | daniel-mar | 1759 | end |
1760 | else |
||
1 | daniel-mar | 1761 | begin |
1762 | PixelFormat := MakeDIBPixelFormat(8, 8, 8); |
||
1763 | end; |
||
4 | daniel-mar | 1764 | SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight, |
1765 | DIBSectionRec^.dsBm.bmBitsPixel); |
||
1766 | end; |
||
1 | daniel-mar | 1767 | else |
1768 | Exit; |
||
1769 | end; |
||
1770 | |||
1771 | FillChar(PBits^, Size, 0); |
||
1772 | Canvas.Draw(0, 0, Source); |
||
1773 | end; |
||
1774 | |||
1775 | procedure AssignGraphic(Source: TGraphic); |
||
4 | daniel-mar | 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} |
||
1 | daniel-mar | 1783 | begin |
4 | daniel-mar | 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} |
||
1 | daniel-mar | 1819 | if Source is TBitmap then |
1820 | AssignBitmap(TBitmap(Source)) |
||
1821 | else |
||
1822 | begin |
||
4 | daniel-mar | 1823 | SetSize(Source.Width, Source.Height, 32); |
1 | daniel-mar | 1824 | FillChar(PBits^, Size, 0); |
1825 | Canvas.Draw(0, 0, Source); |
||
4 | daniel-mar | 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 |
||
1 | daniel-mar | 1834 | end; |
1835 | end; |
||
1836 | |||
1837 | begin |
||
4 | daniel-mar | 1838 | if Source = nil then |
1 | daniel-mar | 1839 | begin |
1840 | Clear; |
||
1841 | end else if Source is TDIB then |
||
1842 | begin |
||
4 | daniel-mar | 1843 | if Source <> Self then |
1 | daniel-mar | 1844 | SetImage(TDIB(Source).FImage); |
1845 | end else if Source is TGraphic then |
||
1846 | begin |
||
1847 | AssignGraphic(TGraphic(Source)); |
||
1848 | end else if Source is TPicture then |
||
1849 | begin |
||
4 | daniel-mar | 1850 | if TPicture(Source).Graphic <> nil then |
1 | daniel-mar | 1851 | AssignGraphic(TPicture(Source).Graphic) |
1852 | else |
||
1853 | Clear; |
||
4 | daniel-mar | 1854 | end else |
1 | daniel-mar | 1855 | inherited Assign(Source); |
1856 | end; |
||
1857 | |||
4 | daniel-mar | 1858 | procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect); |
1 | daniel-mar | 1859 | var |
1860 | OldPalette: HPalette; |
||
1861 | OldMode: Integer; |
||
1862 | begin |
||
4 | daniel-mar | 1863 | if Size > 0 then |
1 | daniel-mar | 1864 | begin |
4 | daniel-mar | 1865 | if PaletteCount > 0 then |
1 | daniel-mar | 1866 | begin |
1867 | OldPalette := SelectPalette(ACanvas.Handle, Palette, False); |
||
1868 | RealizePalette(ACanvas.Handle); |
||
4 | daniel-mar | 1869 | end |
1870 | else |
||
1 | daniel-mar | 1871 | OldPalette := 0; |
1872 | try |
||
1873 | OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR); |
||
1874 | try |
||
1875 | GdiFlush; |
||
1876 | if FImage.FMemoryImage then |
||
1877 | begin |
||
4 | daniel-mar | 1878 | with ARect do |
1879 | begin |
||
1880 | if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
||
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 |
||
1885 | else |
||
1 | daniel-mar | 1886 | begin |
4 | daniel-mar | 1887 | with ARect do |
1 | daniel-mar | 1888 | StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top, |
4 | daniel-mar | 1889 | FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode); |
1 | daniel-mar | 1890 | end; |
1891 | finally |
||
1892 | SetStretchBltMode(ACanvas.Handle, OldMode); |
||
1893 | end; |
||
1894 | finally |
||
1895 | SelectPalette(ACanvas.Handle, OldPalette, False); |
||
1896 | end; |
||
1897 | end; |
||
1898 | end; |
||
1899 | |||
1900 | procedure TDIB.Clear; |
||
1901 | begin |
||
1902 | SetImage(EmptyDIBImage); |
||
1903 | end; |
||
1904 | |||
1905 | procedure TDIB.CanvasChanging(Sender: TObject); |
||
1906 | begin |
||
1907 | Changing(False); |
||
1908 | end; |
||
1909 | |||
1910 | procedure TDIB.Changing(MemoryImage: Boolean); |
||
1911 | var |
||
1912 | TempImage: TDIBSharedImage; |
||
1913 | begin |
||
4 | daniel-mar | 1914 | if (FImage.RefCount > 1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then |
1 | daniel-mar | 1915 | begin |
1916 | TempImage := TDIBSharedImage.Create; |
||
1917 | try |
||
1918 | TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage); |
||
1919 | except |
||
1920 | TempImage.Free; |
||
1921 | raise; |
||
1922 | end; |
||
1923 | SetImage(TempImage); |
||
1924 | end; |
||
1925 | end; |
||
1926 | |||
1927 | procedure TDIB.AllocHandle; |
||
1928 | var |
||
1929 | TempImage: TDIBSharedImage; |
||
1930 | begin |
||
1931 | if FImage.FMemoryImage then |
||
1932 | begin |
||
1933 | TempImage := TDIBSharedImage.Create; |
||
1934 | try |
||
1935 | TempImage.Decompress(FImage, False); |
||
1936 | except |
||
1937 | TempImage.Free; |
||
1938 | raise; |
||
1939 | end; |
||
1940 | SetImage(TempImage); |
||
1941 | end; |
||
1942 | end; |
||
1943 | |||
1944 | procedure TDIB.Compress; |
||
1945 | var |
||
1946 | TempImage: TDIBSharedImage; |
||
1947 | begin |
||
1948 | if (not FImage.FCompressed) and (BitCount in [4, 8]) then |
||
1949 | begin |
||
1950 | TempImage := TDIBSharedImage.Create; |
||
1951 | try |
||
1952 | TempImage.Compress(FImage); |
||
1953 | except |
||
1954 | TempImage.Free; |
||
1955 | raise; |
||
1956 | end; |
||
1957 | SetImage(TempImage); |
||
1958 | end; |
||
1959 | end; |
||
1960 | |||
1961 | procedure TDIB.Decompress; |
||
1962 | var |
||
1963 | TempImage: TDIBSharedImage; |
||
1964 | begin |
||
1965 | if FImage.FCompressed then |
||
1966 | begin |
||
1967 | TempImage := TDIBSharedImage.Create; |
||
1968 | try |
||
1969 | TempImage.Decompress(FImage, FImage.FMemoryImage); |
||
1970 | except |
||
1971 | TempImage.Free; |
||
1972 | raise; |
||
1973 | end; |
||
1974 | SetImage(TempImage); |
||
1975 | end; |
||
1976 | end; |
||
1977 | |||
1978 | procedure TDIB.FreeHandle; |
||
1979 | var |
||
1980 | TempImage: TDIBSharedImage; |
||
1981 | begin |
||
1982 | if not FImage.FMemoryImage then |
||
1983 | begin |
||
1984 | TempImage := TDIBSharedImage.Create; |
||
1985 | try |
||
1986 | TempImage.Duplicate(FImage, True); |
||
1987 | except |
||
1988 | TempImage.Free; |
||
1989 | raise; |
||
1990 | end; |
||
1991 | SetImage(TempImage); |
||
1992 | end; |
||
1993 | end; |
||
1994 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 2150 | function TDIB.GetBitmapInfo: PBitmapInfo; |
2151 | begin |
||
2152 | Result := FImage.FBitmapInfo; |
||
2153 | end; |
||
2154 | |||
2155 | function TDIB.GetBitmapInfoSize: Integer; |
||
2156 | begin |
||
2157 | Result := FImage.FBitmapInfoSize; |
||
2158 | end; |
||
2159 | |||
2160 | function TDIB.GetCanvas: TCanvas; |
||
2161 | begin |
||
4 | daniel-mar | 2162 | if (FCanvas = nil) or (FCanvas.Handle = 0) then |
1 | daniel-mar | 2163 | begin |
2164 | AllocHandle; |
||
2165 | |||
2166 | FCanvas := TCanvas.Create; |
||
2167 | FCanvas.Handle := FImage.FDC; |
||
2168 | FCanvas.OnChanging := CanvasChanging; |
||
2169 | end; |
||
2170 | Result := FCanvas; |
||
2171 | end; |
||
2172 | |||
2173 | function TDIB.GetEmpty: Boolean; |
||
2174 | begin |
||
4 | daniel-mar | 2175 | Result := Size = 0; |
1 | daniel-mar | 2176 | end; |
2177 | |||
2178 | function TDIB.GetHandle: THandle; |
||
2179 | begin |
||
2180 | Changing(True); |
||
2181 | Result := FImage.FHandle; |
||
2182 | end; |
||
2183 | |||
2184 | function TDIB.GetHeight: Integer; |
||
2185 | begin |
||
2186 | Result := FHeight; |
||
2187 | end; |
||
2188 | |||
2189 | function TDIB.GetPalette: HPalette; |
||
2190 | begin |
||
2191 | Result := FImage.GetPalette; |
||
2192 | end; |
||
2193 | |||
2194 | function TDIB.GetPaletteCount: Integer; |
||
2195 | begin |
||
2196 | Result := FImage.FPaletteCount; |
||
2197 | end; |
||
2198 | |||
2199 | function TDIB.GetPBits: Pointer; |
||
2200 | begin |
||
2201 | Changing(True); |
||
2202 | |||
2203 | if not FImage.FMemoryImage then |
||
2204 | GDIFlush; |
||
2205 | Result := FPBits; |
||
2206 | end; |
||
2207 | |||
2208 | function TDIB.GetPBitsReadOnly: Pointer; |
||
2209 | begin |
||
2210 | if not FImage.FMemoryImage then |
||
2211 | GDIFlush; |
||
2212 | Result := FPBits; |
||
2213 | end; |
||
2214 | |||
2215 | function TDIB.GetScanLine(Y: Integer): Pointer; |
||
2216 | begin |
||
2217 | Changing(True); |
||
4 | daniel-mar | 2218 | if (Y < 0) or (Y >= FHeight) then |
1 | daniel-mar | 2219 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
2220 | |||
2221 | if not FImage.FMemoryImage then |
||
2222 | GDIFlush; |
||
4 | daniel-mar | 2223 | Result := Pointer(Integer(FTopPBits) + Y * FNextLine); |
1 | daniel-mar | 2224 | end; |
2225 | |||
2226 | function TDIB.GetScanLineReadOnly(Y: Integer): Pointer; |
||
2227 | begin |
||
4 | daniel-mar | 2228 | if (Y < 0) or (Y >= FHeight) then |
1 | daniel-mar | 2229 | raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]); |
2230 | |||
2231 | if not FImage.FMemoryImage then |
||
2232 | GDIFlush; |
||
4 | daniel-mar | 2233 | Result := Pointer(Integer(FTopPBits) + Y * FNextLine); |
1 | daniel-mar | 2234 | end; |
2235 | |||
2236 | function TDIB.GetTopPBits: Pointer; |
||
2237 | begin |
||
2238 | Changing(True); |
||
2239 | |||
2240 | if not FImage.FMemoryImage then |
||
2241 | GDIFlush; |
||
2242 | Result := FTopPBits; |
||
2243 | end; |
||
2244 | |||
2245 | function TDIB.GetTopPBitsReadOnly: Pointer; |
||
2246 | begin |
||
2247 | if not FImage.FMemoryImage then |
||
2248 | GDIFlush; |
||
2249 | Result := FTopPBits; |
||
4 | daniel-mar | 2250 | end; |
1 | daniel-mar | 2251 | |
2252 | function TDIB.GetWidth: Integer; |
||
2253 | begin |
||
2254 | Result := FWidth; |
||
2255 | end; |
||
2256 | |||
2257 | const |
||
2258 | Mask1: array[0..7] of DWORD = ($80, $40, $20, $10, $08, $04, $02, $01); |
||
2259 | Mask1n: array[0..7] of DWORD = ($FFFFFF7F, $FFFFFFBF, $FFFFFFDF, $FFFFFFEF, |
||
2260 | $FFFFFFF7, $FFFFFFFB, $FFFFFFFD, $FFFFFFFE); |
||
2261 | Mask4: array[0..1] of DWORD = ($F0, $0F); |
||
2262 | Mask4n: array[0..1] of DWORD = ($FFFFFF0F, $FFFFFFF0); |
||
2263 | |||
2264 | Shift1: array[0..7] of DWORD = (7, 6, 5, 4, 3, 2, 1, 0); |
||
2265 | Shift4: array[0..1] of DWORD = (4, 0); |
||
2266 | |||
2267 | function TDIB.GetPixel(X, Y: Integer): DWORD; |
||
2268 | begin |
||
2269 | Decompress; |
||
2270 | |||
2271 | Result := 0; |
||
4 | daniel-mar | 2272 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then |
1 | daniel-mar | 2273 | begin |
2274 | case FBitCount of |
||
4 | daniel-mar | 2275 | 1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
2276 | 4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]); |
||
2277 | 8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X]; |
||
2278 | 16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X]; |
||
2279 | 24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do |
||
2280 | Result := R or (G shl 8) or (B shl 16); |
||
2281 | 32: Result := PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X]; |
||
1 | daniel-mar | 2282 | end; |
2283 | end; |
||
2284 | end; |
||
2285 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 2297 | procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD); |
2298 | var |
||
2299 | P: PByte; |
||
2300 | begin |
||
2301 | Changing(True); |
||
2302 | |||
4 | daniel-mar | 2303 | if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then |
1 | daniel-mar | 2304 | begin |
2305 | case FBitCount of |
||
4 | daniel-mar | 2306 | 1: begin |
2307 | P := @PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]; |
||
2308 | P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]); |
||
2309 | end; |
||
2310 | 4: begin |
||
2311 | P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]); |
||
2312 | P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1])); |
||
2313 | end; |
||
2314 | 8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
||
2315 | 16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
||
2316 | 24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do |
||
2317 | begin |
||
2318 | B := Byte(Value shr 16); |
||
2319 | G := Byte(Value shr 8); |
||
2320 | R := Byte(Value); |
||
2321 | end; |
||
2322 | 32: PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value; |
||
1 | daniel-mar | 2323 | end; |
2324 | end; |
||
2325 | end; |
||
4 | daniel-mar | 2326 | |
2327 | procedure TDIB.SetRGBChannel(const Value: TDIB); |
||
2328 | var |
||
2329 | alpha: TDIB; |
||
2330 | begin |
||
2331 | if Self.HasAlphaChannel then |
||
2332 | try |
||
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 | |||
1 | daniel-mar | 2344 | procedure TDIB.DefineProperties(Filer: TFiler); |
2345 | begin |
||
2346 | inherited DefineProperties(Filer); |
||
2347 | { For interchangeability with an old version. } |
||
2348 | Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False); |
||
2349 | end; |
||
2350 | |||
2351 | type |
||
4 | daniel-mar | 2352 | { TGlobalMemoryStream } |
2353 | |||
1 | daniel-mar | 2354 | TGlobalMemoryStream = class(TMemoryStream) |
2355 | private |
||
2356 | FHandle: THandle; |
||
2357 | public |
||
2358 | constructor Create(AHandle: THandle); |
||
2359 | destructor Destroy; override; |
||
2360 | end; |
||
2361 | |||
2362 | constructor TGlobalMemoryStream.Create(AHandle: THandle); |
||
2363 | begin |
||
2364 | inherited Create; |
||
2365 | FHandle := AHandle; |
||
2366 | SetPointer(GlobalLock(AHandle), GlobalSize(AHandle)); |
||
2367 | end; |
||
2368 | |||
2369 | destructor TGlobalMemoryStream.Destroy; |
||
2370 | begin |
||
2371 | GlobalUnLock(FHandle); |
||
2372 | SetPointer(nil, 0); |
||
2373 | inherited Destroy; |
||
2374 | end; |
||
2375 | |||
2376 | procedure TDIB.LoadFromClipboardFormat(AFormat: Word; AData: THandle; |
||
2377 | APalette: HPALETTE); |
||
2378 | var |
||
2379 | Stream: TGlobalMemoryStream; |
||
2380 | begin |
||
2381 | Stream := TGlobalMemoryStream.Create(AData); |
||
2382 | try |
||
2383 | ReadData(Stream); |
||
2384 | finally |
||
2385 | Stream.Free; |
||
2386 | end; |
||
2387 | end; |
||
2388 | |||
2389 | const |
||
4 | daniel-mar | 2390 | BitmapFileType = Ord('B') + Ord('M') * $100; |
1 | daniel-mar | 2391 | |
2392 | procedure TDIB.LoadFromStream(Stream: TStream); |
||
2393 | var |
||
2394 | BF: TBitmapFileHeader; |
||
2395 | i: Integer; |
||
4 | daniel-mar | 2396 | ImageJPEG: TJPEGImage; |
1 | daniel-mar | 2397 | begin |
2398 | { File header reading } |
||
2399 | i := Stream.Read(BF, SizeOf(TBitmapFileHeader)); |
||
4 | daniel-mar | 2400 | if i = 0 then Exit; |
2401 | if i <> SizeOf(TBitmapFileHeader) then |
||
1 | daniel-mar | 2402 | raise EInvalidGraphic.Create(SInvalidDIB); |
2403 | |||
4 | daniel-mar | 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 |
||
1 | daniel-mar | 2428 | { Is the head 'BM'? } |
4 | daniel-mar | 2429 | if BF.bfType <> BitmapFileType then |
2430 | raise EInvalidGraphic.Create(SInvalidDIB); |
||
1 | daniel-mar | 2431 | |
2432 | ReadData(Stream); |
||
2433 | end; |
||
2434 | |||
2435 | procedure TDIB.ReadData(Stream: TStream); |
||
2436 | var |
||
2437 | TempImage: TDIBSharedImage; |
||
2438 | begin |
||
2439 | TempImage := TDIBSharedImage.Create; |
||
2440 | try |
||
2441 | TempImage.ReadData(Stream, FImage.FMemoryImage); |
||
2442 | except |
||
2443 | TempImage.Free; |
||
2444 | raise; |
||
2445 | end; |
||
2446 | SetImage(TempImage); |
||
2447 | end; |
||
2448 | |||
2449 | procedure TDIB.SaveToClipboardFormat(var AFormat: Word; var AData: THandle; |
||
2450 | var APalette: HPALETTE); |
||
2451 | var |
||
2452 | P: Pointer; |
||
2453 | Stream: TMemoryStream; |
||
2454 | begin |
||
2455 | AFormat := CF_DIB; |
||
2456 | APalette := 0; |
||
2457 | |||
2458 | Stream := TMemoryStream.Create; |
||
2459 | try |
||
2460 | WriteData(Stream); |
||
2461 | |||
2462 | AData := GlobalAlloc(GHND, Stream.Size); |
||
4 | daniel-mar | 2463 | if AData = 0 then OutOfMemoryError; |
1 | daniel-mar | 2464 | |
2465 | P := GlobalLock(AData); |
||
2466 | Move(Stream.Memory^, P^, Stream.Size); |
||
2467 | GlobalUnLock(AData); |
||
2468 | finally |
||
2469 | Stream.Free; |
||
2470 | end; |
||
2471 | end; |
||
2472 | |||
2473 | procedure TDIB.SaveToStream(Stream: TStream); |
||
2474 | var |
||
2475 | BF: TBitmapFileHeader; |
||
2476 | begin |
||
2477 | if Empty then Exit; |
||
2478 | |||
2479 | with BF do |
||
2480 | begin |
||
4 | daniel-mar | 2481 | bfType := BitmapFileType; |
2482 | bfOffBits := SizeOf(TBitmapFileHeader) + BitmapInfoSize; |
||
2483 | bfSize := bfOffBits + FImage.FBitmapInfo^.bmiHeader.biSizeImage; |
||
1 | daniel-mar | 2484 | bfReserved1 := 0; |
2485 | bfReserved2 := 0; |
||
2486 | end; |
||
2487 | Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader)); |
||
2488 | |||
2489 | WriteData(Stream); |
||
2490 | end; |
||
2491 | |||
2492 | procedure TDIB.WriteData(Stream: TStream); |
||
2493 | begin |
||
2494 | if Empty then Exit; |
||
2495 | |||
2496 | if not FImage.FMemoryImage then |
||
2497 | GDIFlush; |
||
2498 | |||
2499 | Stream.WriteBuffer(FImage.FBitmapInfo^, FImage.FBitmapInfoSize); |
||
2500 | Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage); |
||
2501 | end; |
||
2502 | |||
2503 | procedure TDIB.SetBitCount(Value: Integer); |
||
2504 | begin |
||
4 | daniel-mar | 2505 | if Value <= 0 then |
1 | daniel-mar | 2506 | Clear |
2507 | else |
||
2508 | begin |
||
2509 | if Empty then |
||
2510 | begin |
||
2511 | SetSize(Max(Width, 1), Max(Height, 1), Value) |
||
4 | daniel-mar | 2512 | end |
2513 | else |
||
1 | daniel-mar | 2514 | begin |
2515 | ConvertBitCount(Value); |
||
2516 | end; |
||
2517 | end; |
||
2518 | end; |
||
2519 | |||
2520 | procedure TDIB.SetHeight(Value: Integer); |
||
2521 | begin |
||
4 | daniel-mar | 2522 | if Value <= 0 then |
1 | daniel-mar | 2523 | Clear |
2524 | else |
||
2525 | begin |
||
2526 | if Empty then |
||
2527 | SetSize(Max(Width, 1), Value, 8) |
||
2528 | else |
||
2529 | SetSize(Width, Value, BitCount); |
||
2530 | end; |
||
2531 | end; |
||
2532 | |||
2533 | procedure TDIB.SetWidth(Value: Integer); |
||
2534 | begin |
||
4 | daniel-mar | 2535 | if Value <= 0 then |
1 | daniel-mar | 2536 | Clear |
2537 | else |
||
2538 | begin |
||
2539 | if Empty then |
||
2540 | SetSize(Value, Max(Height, 1), 8) |
||
2541 | else |
||
2542 | SetSize(Value, Height, BitCount); |
||
2543 | end; |
||
2544 | end; |
||
2545 | |||
2546 | procedure TDIB.SetImage(Value: TDIBSharedImage); |
||
2547 | begin |
||
4 | daniel-mar | 2548 | if FImage <> Value then |
1 | daniel-mar | 2549 | begin |
4 | daniel-mar | 2550 | if FCanvas <> nil then |
1 | daniel-mar | 2551 | FCanvas.Handle := 0; |
4 | daniel-mar | 2552 | |
1 | daniel-mar | 2553 | FImage.Release; |
2554 | FImage := Value; |
||
2555 | FImage.Reference; |
||
2556 | |||
4 | daniel-mar | 2557 | if FCanvas <> nil then |
1 | daniel-mar | 2558 | FCanvas.Handle := FImage.FDC; |
2559 | |||
2560 | ColorTable := FImage.FColorTable; |
||
2561 | PixelFormat := FImage.FPixelFormat; |
||
2562 | |||
2563 | FBitCount := FImage.FBitCount; |
||
2564 | FHeight := FImage.FHeight; |
||
2565 | FNextLine := FImage.FNextLine; |
||
2566 | FNowPixelFormat := FImage.FPixelFormat; |
||
2567 | FPBits := FImage.FPBits; |
||
2568 | FSize := FImage.FSize; |
||
2569 | FTopPBits := FImage.FTopPBits; |
||
2570 | FWidth := FImage.FWidth; |
||
2571 | FWidthBytes := FImage.FWidthBytes; |
||
2572 | end; |
||
2573 | end; |
||
2574 | |||
2575 | procedure TDIB.SetNowPixelFormat(const Value: TDIBPixelFormat); |
||
2576 | var |
||
2577 | Temp: TDIB; |
||
2578 | begin |
||
2579 | if CompareMem(@Value, @FImage.FPixelFormat, SizeOf(TDIBPixelFormat)) then exit; |
||
2580 | |||
2581 | PixelFormat := Value; |
||
2582 | |||
2583 | Temp := TDIB.Create; |
||
2584 | try |
||
2585 | Temp.Assign(Self); |
||
2586 | SetSize(Width, Height, BitCount); |
||
2587 | Canvas.Draw(0, 0, Temp); |
||
2588 | finally |
||
2589 | Temp.Free; |
||
2590 | end; |
||
2591 | end; |
||
2592 | |||
2593 | procedure TDIB.SetPalette(Value: HPalette); |
||
2594 | var |
||
2595 | PaletteEntries: TPaletteEntries; |
||
2596 | begin |
||
2597 | GetPaletteEntries(Value, 0, 256, PaletteEntries); |
||
2598 | DeleteObject(Value); |
||
2599 | |||
2600 | ColorTable := PaletteEntriesToRGBQuads(PaletteEntries); |
||
2601 | UpdatePalette; |
||
2602 | end; |
||
2603 | |||
2604 | procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer); |
||
2605 | var |
||
2606 | TempImage: TDIBSharedImage; |
||
2607 | begin |
||
4 | daniel-mar | 2608 | if (AWidth = Width) and (AHeight = Height) and (ABitCount = BitCount) and |
2609 | (NowPixelFormat.RBitMask = PixelFormat.RBitMask) and |
||
2610 | (NowPixelFormat.GBitMask = PixelFormat.GBitMask) and |
||
2611 | (NowPixelFormat.BBitMask = PixelFormat.BBitMask) then Exit; |
||
1 | daniel-mar | 2612 | |
4 | daniel-mar | 2613 | if (AWidth <= 0) or (AHeight <= 0) then |
1 | daniel-mar | 2614 | begin |
2615 | Clear; |
||
2616 | Exit; |
||
2617 | end; |
||
2618 | |||
2619 | TempImage := TDIBSharedImage.Create; |
||
2620 | try |
||
2621 | TempImage.NewImage(AWidth, AHeight, ABitCount, |
||
2622 | PixelFormat, ColorTable, FImage.FMemoryImage, False); |
||
2623 | except |
||
2624 | TempImage.Free; |
||
2625 | raise; |
||
2626 | end; |
||
2627 | SetImage(TempImage); |
||
2628 | |||
2629 | PaletteModified := True; |
||
2630 | end; |
||
2631 | |||
2632 | procedure TDIB.UpdatePalette; |
||
2633 | var |
||
2634 | Col: TRGBQuads; |
||
2635 | begin |
||
2636 | if CompareMem(@ColorTable, @FImage.FColorTable, SizeOf(ColorTable)) then Exit; |
||
2637 | |||
2638 | Col := ColorTable; |
||
2639 | Changing(True); |
||
2640 | ColorTable := Col; |
||
2641 | FImage.SetColorTable(ColorTable); |
||
2642 | |||
2643 | PaletteModified := True; |
||
2644 | end; |
||
2645 | |||
2646 | procedure TDIB.ConvertBitCount(ABitCount: Integer); |
||
2647 | var |
||
2648 | Temp: TDIB; |
||
2649 | |||
2650 | procedure CreateHalftonePalette(R, G, B: Integer); |
||
2651 | var |
||
2652 | i: Integer; |
||
2653 | begin |
||
4 | daniel-mar | 2654 | for i := 0 to 255 do |
1 | daniel-mar | 2655 | with ColorTable[i] do |
2656 | begin |
||
4 | daniel-mar | 2657 | rgbRed := ((i shr (G + B - 1)) and (1 shl R - 1)) * 255 div (1 shl R - 1); |
2658 | rgbGreen := ((i shr (B - 1)) and (1 shl G - 1)) * 255 div (1 shl G - 1); |
||
2659 | rgbBlue := ((i shr 0) and (1 shl B - 1)) * 255 div (1 shl B - 1); |
||
1 | daniel-mar | 2660 | end; |
2661 | end; |
||
2662 | |||
2663 | procedure PaletteToPalette_Inc; |
||
2664 | var |
||
2665 | x, y: Integer; |
||
2666 | i: DWORD; |
||
2667 | SrcP, DestP: Pointer; |
||
2668 | P: PByte; |
||
2669 | begin |
||
2670 | i := 0; |
||
2671 | |||
4 | daniel-mar | 2672 | for y := 0 to Height - 1 do |
1 | daniel-mar | 2673 | begin |
2674 | SrcP := Temp.ScanLine[y]; |
||
2675 | DestP := ScanLine[y]; |
||
2676 | |||
4 | daniel-mar | 2677 | for x := 0 to Width - 1 do |
1 | daniel-mar | 2678 | begin |
2679 | case Temp.BitCount of |
||
4 | daniel-mar | 2680 | 1: |
2681 | begin |
||
2682 | i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]; |
||
2683 | end; |
||
2684 | 4: |
||
2685 | begin |
||
2686 | i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1]; |
||
2687 | end; |
||
2688 | 8: |
||
2689 | begin |
||
2690 | i := PByte(SrcP)^; |
||
2691 | Inc(PByte(SrcP)); |
||
2692 | end; |
||
1 | daniel-mar | 2693 | end; |
2694 | |||
2695 | case BitCount of |
||
4 | daniel-mar | 2696 | 1: |
2697 | begin |
||
2698 | P := @PArrayByte(DestP)[X shr 3]; |
||
2699 | P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]); |
||
2700 | end; |
||
2701 | 4: |
||
2702 | begin |
||
2703 | P := @PArrayByte(DestP)[X shr 1]; |
||
2704 | P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]); |
||
2705 | end; |
||
2706 | 8: |
||
2707 | begin |
||
2708 | PByte(DestP)^ := i; |
||
2709 | Inc(PByte(DestP)); |
||
2710 | end; |
||
1 | daniel-mar | 2711 | end; |
2712 | end; |
||
2713 | end; |
||
2714 | end; |
||
2715 | |||
2716 | procedure PaletteToRGB_or_RGBToRGB; |
||
2717 | var |
||
2718 | x, y: Integer; |
||
2719 | SrcP, DestP: Pointer; |
||
2720 | cR, cG, cB: Byte; |
||
2721 | begin |
||
2722 | cR := 0; |
||
2723 | cG := 0; |
||
2724 | cB := 0; |
||
2725 | |||
4 | daniel-mar | 2726 | for y := 0 to Height - 1 do |
1 | daniel-mar | 2727 | begin |
2728 | SrcP := Temp.ScanLine[y]; |
||
2729 | DestP := ScanLine[y]; |
||
2730 | |||
4 | daniel-mar | 2731 | for x := 0 to Width - 1 do |
1 | daniel-mar | 2732 | begin |
2733 | case Temp.BitCount of |
||
4 | daniel-mar | 2734 | 1: |
2735 | begin |
||
2736 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
||
2737 | begin |
||
2738 | cR := rgbRed; |
||
2739 | cG := rgbGreen; |
||
2740 | cB := rgbBlue; |
||
1 | daniel-mar | 2741 | end; |
4 | daniel-mar | 2742 | end; |
2743 | 4: |
||
2744 | begin |
||
2745 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
||
2746 | begin |
||
2747 | cR := rgbRed; |
||
2748 | cG := rgbGreen; |
||
2749 | cB := rgbBlue; |
||
1 | daniel-mar | 2750 | end; |
4 | daniel-mar | 2751 | end; |
2752 | 8: |
||
2753 | begin |
||
2754 | with Temp.ColorTable[PByte(SrcP)^] do |
||
2755 | begin |
||
2756 | cR := rgbRed; |
||
2757 | cG := rgbGreen; |
||
2758 | cB := rgbBlue; |
||
1 | daniel-mar | 2759 | end; |
4 | daniel-mar | 2760 | Inc(PByte(SrcP)); |
2761 | end; |
||
2762 | 16: |
||
2763 | begin |
||
2764 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB); |
||
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; |
||
1 | daniel-mar | 2774 | end; |
2775 | |||
4 | daniel-mar | 2776 | Inc(PBGR(SrcP)); |
2777 | end; |
||
2778 | 32: |
||
2779 | begin |
||
2780 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB); |
||
2781 | Inc(PDWORD(SrcP)); |
||
2782 | end; |
||
1 | daniel-mar | 2783 | end; |
2784 | |||
2785 | case BitCount of |
||
4 | daniel-mar | 2786 | 16: |
2787 | begin |
||
2788 | PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
||
2789 | Inc(PWord(DestP)); |
||
2790 | end; |
||
2791 | 24: |
||
2792 | begin |
||
2793 | with PBGR(DestP)^ do |
||
2794 | begin |
||
2795 | R := cR; |
||
2796 | G := cG; |
||
2797 | B := cB; |
||
1 | daniel-mar | 2798 | end; |
4 | daniel-mar | 2799 | Inc(PBGR(DestP)); |
2800 | end; |
||
2801 | 32: |
||
2802 | begin |
||
2803 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB); |
||
2804 | Inc(PDWORD(DestP)); |
||
2805 | end; |
||
1 | daniel-mar | 2806 | end; |
2807 | end; |
||
2808 | end; |
||
2809 | end; |
||
2810 | |||
2811 | begin |
||
4 | daniel-mar | 2812 | if Size = 0 then exit; |
1 | daniel-mar | 2813 | |
2814 | Temp := TDIB.Create; |
||
2815 | try |
||
2816 | Temp.Assign(Self); |
||
2817 | SetSize(Temp.Width, Temp.Height, ABitCount); |
||
2818 | |||
4 | daniel-mar | 2819 | if FImage = Temp.FImage then Exit; |
1 | daniel-mar | 2820 | |
4 | daniel-mar | 2821 | if (Temp.BitCount <= 8) and (BitCount <= 8) then |
1 | daniel-mar | 2822 | begin |
2823 | { The image is converted from the palette color image into the palette color image. } |
||
4 | daniel-mar | 2824 | if Temp.BitCount <= BitCount then |
1 | daniel-mar | 2825 | begin |
2826 | PaletteToPalette_Inc; |
||
4 | daniel-mar | 2827 | end |
2828 | else |
||
1 | daniel-mar | 2829 | begin |
2830 | case BitCount of |
||
2831 | 1: begin |
||
4 | daniel-mar | 2832 | ColorTable[0] := RGBQuad(0, 0, 0); |
2833 | ColorTable[1] := RGBQuad(255, 255, 255); |
||
2834 | end; |
||
1 | daniel-mar | 2835 | 4: CreateHalftonePalette(1, 2, 1); |
2836 | 8: CreateHalftonePalette(3, 3, 2); |
||
2837 | end; |
||
2838 | UpdatePalette; |
||
2839 | |||
2840 | Canvas.Draw(0, 0, Temp); |
||
2841 | end; |
||
4 | daniel-mar | 2842 | end |
2843 | else |
||
2844 | if (Temp.BitCount <= 8) and (BitCount > 8) then |
||
2845 | begin |
||
2846 | { The image is converted from the palette color image into the rgb color image. } |
||
2847 | PaletteToRGB_or_RGBToRGB; |
||
2848 | end |
||
2849 | else |
||
2850 | if (Temp.BitCount > 8) and (BitCount <= 8) then |
||
2851 | begin |
||
2852 | { The image is converted from the rgb color image into the palette color image. } |
||
2853 | case BitCount of |
||
2854 | 1: begin |
||
2855 | ColorTable[0] := RGBQuad(0, 0, 0); |
||
2856 | ColorTable[1] := RGBQuad(255, 255, 255); |
||
2857 | end; |
||
2858 | 4: CreateHalftonePalette(1, 2, 1); |
||
2859 | 8: CreateHalftonePalette(3, 3, 2); |
||
2860 | end; |
||
2861 | UpdatePalette; |
||
1 | daniel-mar | 2862 | |
4 | daniel-mar | 2863 | Canvas.Draw(0, 0, Temp); |
2864 | end |
||
2865 | else |
||
2866 | if (Temp.BitCount > 8) and (BitCount > 8) then |
||
2867 | begin |
||
2868 | { The image is converted from the rgb color image into the rgb color image. } |
||
2869 | PaletteToRGB_or_RGBToRGB; |
||
2870 | end; |
||
1 | daniel-mar | 2871 | finally |
2872 | Temp.Free; |
||
2873 | end; |
||
2874 | end; |
||
2875 | |||
2876 | { Special effect } |
||
2877 | |||
2878 | procedure TDIB.StartProgress(const Name: string); |
||
2879 | begin |
||
2880 | FProgressName := Name; |
||
2881 | FProgressOld := 0; |
||
2882 | FProgressOldTime := GetTickCount; |
||
2883 | FProgressY := 0; |
||
2884 | FProgressOldY := 0; |
||
2885 | Progress(Self, psStarting, 0, False, Rect(0, 0, Width, Height), FProgressName); |
||
2886 | end; |
||
2887 | |||
2888 | procedure TDIB.EndProgress; |
||
2889 | begin |
||
2890 | Progress(Self, psEnding, 100, True, Rect(0, FProgressOldY, Width, Height), FProgressName); |
||
2891 | end; |
||
2892 | |||
2893 | procedure TDIB.UpdateProgress(PercentY: Integer); |
||
2894 | var |
||
2895 | Redraw: Boolean; |
||
2896 | Percent: DWORD; |
||
2897 | begin |
||
4 | daniel-mar | 2898 | Redraw := (GetTickCount - FProgressOldTime > 200) and (FProgressY - FProgressOldY > 32) and |
2899 | (((Height div 3 > Integer(FProgressY)) and (FProgressOldY = 0)) or (FProgressOldY <> 0)); |
||
1 | daniel-mar | 2900 | |
4 | daniel-mar | 2901 | Percent := PercentY * 100 div Height; |
1 | daniel-mar | 2902 | |
4 | daniel-mar | 2903 | if (Percent <> FProgressOld) or (Redraw) then |
1 | daniel-mar | 2904 | begin |
2905 | Progress(Self, psRunning, Percent, Redraw, |
||
2906 | Rect(0, FProgressOldY, Width, FProgressY), FProgressName); |
||
2907 | if Redraw then |
||
2908 | begin |
||
2909 | FProgressOldY := FProgressY; |
||
2910 | FProgressOldTime := GetTickCount; |
||
2911 | end; |
||
2912 | |||
2913 | FProgressOld := Percent; |
||
2914 | end; |
||
2915 | |||
2916 | Inc(FProgressY); |
||
2917 | end; |
||
2918 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 3124 | procedure TDIB.Blur(ABitCount: Integer; Radius: Integer); |
3125 | type |
||
3126 | TAve = record |
||
3127 | cR, cG, cB: DWORD; |
||
3128 | c: DWORD; |
||
3129 | end; |
||
3130 | TArrayAve = array[0..0] of TAve; |
||
3131 | |||
3132 | var |
||
3133 | Temp: TDIB; |
||
3134 | |||
3135 | procedure AddAverage(Y, XCount: Integer; var Ave: TArrayAve); |
||
3136 | var |
||
3137 | X: Integer; |
||
3138 | SrcP: Pointer; |
||
3139 | AveP: ^TAve; |
||
3140 | R, G, B: Byte; |
||
3141 | begin |
||
3142 | case Temp.BitCount of |
||
4 | daniel-mar | 3143 | 1: |
3144 | begin |
||
3145 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3146 | AveP := @Ave; |
||
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 |
||
1 | daniel-mar | 3150 | begin |
4 | daniel-mar | 3151 | Inc(cR, rgbRed); |
3152 | Inc(cG, rgbGreen); |
||
3153 | Inc(cB, rgbBlue); |
||
3154 | Inc(c); |
||
1 | daniel-mar | 3155 | end; |
4 | daniel-mar | 3156 | Inc(AveP); |
1 | daniel-mar | 3157 | end; |
4 | daniel-mar | 3158 | end; |
3159 | 4: |
||
3160 | begin |
||
3161 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3162 | AveP := @Ave; |
||
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 |
||
1 | daniel-mar | 3166 | begin |
4 | daniel-mar | 3167 | Inc(cR, rgbRed); |
3168 | Inc(cG, rgbGreen); |
||
3169 | Inc(cB, rgbBlue); |
||
3170 | Inc(c); |
||
1 | daniel-mar | 3171 | end; |
4 | daniel-mar | 3172 | Inc(AveP); |
1 | daniel-mar | 3173 | end; |
4 | daniel-mar | 3174 | end; |
3175 | 8: |
||
3176 | begin |
||
3177 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3178 | AveP := @Ave; |
||
3179 | for x := 0 to XCount - 1 do |
||
3180 | begin |
||
3181 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
||
1 | daniel-mar | 3182 | begin |
4 | daniel-mar | 3183 | Inc(cR, rgbRed); |
3184 | Inc(cG, rgbGreen); |
||
3185 | Inc(cB, rgbBlue); |
||
3186 | Inc(c); |
||
1 | daniel-mar | 3187 | end; |
4 | daniel-mar | 3188 | Inc(PByte(SrcP)); |
3189 | Inc(AveP); |
||
1 | daniel-mar | 3190 | end; |
4 | daniel-mar | 3191 | end; |
3192 | 16: |
||
3193 | begin |
||
3194 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3195 | AveP := @Ave; |
||
3196 | for x := 0 to XCount - 1 do |
||
3197 | begin |
||
3198 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
3199 | with AveP^ do |
||
1 | daniel-mar | 3200 | begin |
4 | daniel-mar | 3201 | Inc(cR, R); |
3202 | Inc(cG, G); |
||
3203 | Inc(cB, B); |
||
3204 | Inc(c); |
||
1 | daniel-mar | 3205 | end; |
4 | daniel-mar | 3206 | Inc(PWord(SrcP)); |
3207 | Inc(AveP); |
||
1 | daniel-mar | 3208 | end; |
4 | daniel-mar | 3209 | end; |
3210 | 24: |
||
3211 | begin |
||
3212 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3213 | AveP := @Ave; |
||
3214 | for x := 0 to XCount - 1 do |
||
3215 | begin |
||
3216 | with PBGR(SrcP)^, AveP^ do |
||
1 | daniel-mar | 3217 | begin |
4 | daniel-mar | 3218 | Inc(cR, R); |
3219 | Inc(cG, G); |
||
3220 | Inc(cB, B); |
||
3221 | Inc(c); |
||
1 | daniel-mar | 3222 | end; |
4 | daniel-mar | 3223 | Inc(PBGR(SrcP)); |
3224 | Inc(AveP); |
||
1 | daniel-mar | 3225 | end; |
4 | daniel-mar | 3226 | end; |
3227 | 32: |
||
3228 | begin |
||
3229 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3230 | AveP := @Ave; |
||
3231 | for x := 0 to XCount - 1 do |
||
3232 | begin |
||
3233 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
3234 | with AveP^ do |
||
1 | daniel-mar | 3235 | begin |
4 | daniel-mar | 3236 | Inc(cR, R); |
3237 | Inc(cG, G); |
||
3238 | Inc(cB, B); |
||
3239 | Inc(c); |
||
1 | daniel-mar | 3240 | end; |
4 | daniel-mar | 3241 | Inc(PDWORD(SrcP)); |
3242 | Inc(AveP); |
||
1 | daniel-mar | 3243 | end; |
4 | daniel-mar | 3244 | end; |
1 | daniel-mar | 3245 | end; |
3246 | end; |
||
3247 | |||
3248 | procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve); |
||
3249 | var |
||
3250 | X: Integer; |
||
3251 | SrcP: Pointer; |
||
3252 | AveP: ^TAve; |
||
3253 | R, G, B: Byte; |
||
3254 | begin |
||
3255 | case Temp.BitCount of |
||
4 | daniel-mar | 3256 | 1: |
3257 | begin |
||
3258 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3259 | AveP := @Ave; |
||
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 |
||
1 | daniel-mar | 3263 | begin |
4 | daniel-mar | 3264 | Dec(cR, rgbRed); |
3265 | Dec(cG, rgbGreen); |
||
3266 | Dec(cB, rgbBlue); |
||
3267 | Dec(c); |
||
1 | daniel-mar | 3268 | end; |
4 | daniel-mar | 3269 | Inc(AveP); |
1 | daniel-mar | 3270 | end; |
4 | daniel-mar | 3271 | end; |
3272 | 4: |
||
3273 | begin |
||
3274 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3275 | AveP := @Ave; |
||
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 |
||
1 | daniel-mar | 3279 | begin |
4 | daniel-mar | 3280 | Dec(cR, rgbRed); |
3281 | Dec(cG, rgbGreen); |
||
3282 | Dec(cB, rgbBlue); |
||
3283 | Dec(c); |
||
1 | daniel-mar | 3284 | end; |
4 | daniel-mar | 3285 | Inc(AveP); |
1 | daniel-mar | 3286 | end; |
4 | daniel-mar | 3287 | end; |
3288 | 8: |
||
3289 | begin |
||
3290 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3291 | AveP := @Ave; |
||
3292 | for x := 0 to XCount - 1 do |
||
3293 | begin |
||
3294 | with Temp.ColorTable[PByte(SrcP)^], AveP^ do |
||
1 | daniel-mar | 3295 | begin |
4 | daniel-mar | 3296 | Dec(cR, rgbRed); |
3297 | Dec(cG, rgbGreen); |
||
3298 | Dec(cB, rgbBlue); |
||
3299 | Dec(c); |
||
1 | daniel-mar | 3300 | end; |
4 | daniel-mar | 3301 | Inc(PByte(SrcP)); |
3302 | Inc(AveP); |
||
1 | daniel-mar | 3303 | end; |
4 | daniel-mar | 3304 | end; |
3305 | 16: |
||
3306 | begin |
||
3307 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3308 | AveP := @Ave; |
||
3309 | for x := 0 to XCount - 1 do |
||
3310 | begin |
||
3311 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
3312 | with AveP^ do |
||
1 | daniel-mar | 3313 | begin |
4 | daniel-mar | 3314 | Dec(cR, R); |
3315 | Dec(cG, G); |
||
3316 | Dec(cB, B); |
||
3317 | Dec(c); |
||
1 | daniel-mar | 3318 | end; |
4 | daniel-mar | 3319 | Inc(PWord(SrcP)); |
3320 | Inc(AveP); |
||
1 | daniel-mar | 3321 | end; |
4 | daniel-mar | 3322 | end; |
3323 | 24: |
||
3324 | begin |
||
3325 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3326 | AveP := @Ave; |
||
3327 | for x := 0 to XCount - 1 do |
||
3328 | begin |
||
3329 | with PBGR(SrcP)^, AveP^ do |
||
1 | daniel-mar | 3330 | begin |
4 | daniel-mar | 3331 | Dec(cR, R); |
3332 | Dec(cG, G); |
||
3333 | Dec(cB, B); |
||
3334 | Dec(c); |
||
1 | daniel-mar | 3335 | end; |
4 | daniel-mar | 3336 | Inc(PBGR(SrcP)); |
3337 | Inc(AveP); |
||
1 | daniel-mar | 3338 | end; |
4 | daniel-mar | 3339 | end; |
3340 | 32: |
||
3341 | begin |
||
3342 | SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine); |
||
3343 | AveP := @Ave; |
||
3344 | for x := 0 to XCount - 1 do |
||
3345 | begin |
||
3346 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
3347 | with AveP^ do |
||
1 | daniel-mar | 3348 | begin |
4 | daniel-mar | 3349 | Dec(cR, R); |
3350 | Dec(cG, G); |
||
3351 | Dec(cB, B); |
||
3352 | Dec(c); |
||
1 | daniel-mar | 3353 | end; |
4 | daniel-mar | 3354 | Inc(PDWORD(SrcP)); |
3355 | Inc(AveP); |
||
1 | daniel-mar | 3356 | end; |
4 | daniel-mar | 3357 | end; |
1 | daniel-mar | 3358 | end; |
3359 | end; |
||
3360 | |||
3361 | procedure Blur_Radius_Other; |
||
3362 | var |
||
3363 | FirstX, LastX, FirstX2, LastX2, FirstY, LastY: Integer; |
||
3364 | x, y, x2, y2, jx, jy: Integer; |
||
3365 | Ave: TAve; |
||
3366 | AveX: ^TArrayAve; |
||
3367 | DestP: Pointer; |
||
3368 | P: PByte; |
||
3369 | begin |
||
4 | daniel-mar | 3370 | GetMem(AveX, Width * SizeOf(TAve)); |
1 | daniel-mar | 3371 | try |
4 | daniel-mar | 3372 | FillChar(AveX^, Width * SizeOf(TAve), 0); |
1 | daniel-mar | 3373 | |
3374 | FirstX2 := -1; |
||
3375 | LastX2 := -1; |
||
3376 | FirstY := -1; |
||
3377 | LastY := -1; |
||
3378 | |||
3379 | x := 0; |
||
4 | daniel-mar | 3380 | for x2 := -Radius to Radius do |
1 | daniel-mar | 3381 | begin |
4 | daniel-mar | 3382 | jx := x + x2; |
3383 | if (jx >= 0) and (jx < Width) then |
||
1 | daniel-mar | 3384 | begin |
4 | daniel-mar | 3385 | if FirstX2 = -1 then FirstX2 := jx; |
3386 | if LastX2 < jx then LastX2 := jx; |
||
1 | daniel-mar | 3387 | end; |
3388 | end; |
||
3389 | |||
3390 | y := 0; |
||
4 | daniel-mar | 3391 | for y2 := -Radius to Radius do |
1 | daniel-mar | 3392 | begin |
4 | daniel-mar | 3393 | jy := y + y2; |
3394 | if (jy >= 0) and (jy < Height) then |
||
1 | daniel-mar | 3395 | begin |
4 | daniel-mar | 3396 | if FirstY = -1 then FirstY := jy; |
3397 | if LastY < jy then LastY := jy; |
||
1 | daniel-mar | 3398 | end; |
3399 | end; |
||
3400 | |||
4 | daniel-mar | 3401 | for y := FirstY to LastY do |
1 | daniel-mar | 3402 | AddAverage(y, Temp.Width, AveX^); |
3403 | |||
4 | daniel-mar | 3404 | for y := 0 to Height - 1 do |
1 | daniel-mar | 3405 | begin |
3406 | DestP := ScanLine[y]; |
||
3407 | |||
3408 | { The average is updated. } |
||
4 | daniel-mar | 3409 | if y - FirstY = Radius + 1 then |
1 | daniel-mar | 3410 | begin |
3411 | DeleteAverage(FirstY, Temp.Width, AveX^); |
||
3412 | Inc(FirstY); |
||
3413 | end; |
||
3414 | |||
4 | daniel-mar | 3415 | if LastY - y = Radius - 1 then |
1 | daniel-mar | 3416 | begin |
4 | daniel-mar | 3417 | Inc(LastY); if LastY >= Height then LastY := Height - 1; |
1 | daniel-mar | 3418 | AddAverage(LastY, Temp.Width, AveX^); |
3419 | end; |
||
3420 | |||
3421 | { The average is calculated again. } |
||
3422 | FirstX := FirstX2; |
||
3423 | LastX := LastX2; |
||
3424 | |||
3425 | FillChar(Ave, SizeOf(Ave), 0); |
||
4 | daniel-mar | 3426 | for x := FirstX to LastX do |
1 | daniel-mar | 3427 | with AveX[x] do |
3428 | begin |
||
3429 | Inc(Ave.cR, cR); |
||
3430 | Inc(Ave.cG, cG); |
||
3431 | Inc(Ave.cB, cB); |
||
3432 | Inc(Ave.c, c); |
||
3433 | end; |
||
3434 | |||
4 | daniel-mar | 3435 | for x := 0 to Width - 1 do |
1 | daniel-mar | 3436 | begin |
3437 | { The average is updated. } |
||
4 | daniel-mar | 3438 | if x - FirstX = Radius + 1 then |
1 | daniel-mar | 3439 | begin |
3440 | with AveX[FirstX] do |
||
3441 | begin |
||
3442 | Dec(Ave.cR, cR); |
||
3443 | Dec(Ave.cG, cG); |
||
3444 | Dec(Ave.cB, cB); |
||
3445 | Dec(Ave.c, c); |
||
3446 | end; |
||
3447 | Inc(FirstX); |
||
3448 | end; |
||
3449 | |||
4 | daniel-mar | 3450 | if LastX - x = Radius - 1 then |
1 | daniel-mar | 3451 | begin |
4 | daniel-mar | 3452 | Inc(LastX); if LastX >= Width then LastX := Width - 1; |
1 | daniel-mar | 3453 | with AveX[LastX] do |
3454 | begin |
||
3455 | Inc(Ave.cR, cR); |
||
3456 | Inc(Ave.cG, cG); |
||
3457 | Inc(Ave.cB, cB); |
||
3458 | Inc(Ave.c, c); |
||
3459 | end; |
||
3460 | end; |
||
3461 | |||
3462 | { The average is written. } |
||
3463 | case BitCount of |
||
4 | daniel-mar | 3464 | 1: |
3465 | begin |
||
3466 | P := @PArrayByte(DestP)[X shr 3]; |
||
3467 | with Ave do |
||
3468 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR + cG + cB) div c) div 3 > 127)) shl Shift1[X and 7]); |
||
3469 | end; |
||
3470 | 4: |
||
3471 | begin |
||
3472 | P := @PArrayByte(DestP)[X shr 1]; |
||
3473 | with Ave do |
||
3474 | P^ := (P^ and Mask4n[X and 1]) or (((((cR + cG + cB) div c) div 3) shr 4) shl Shift4[X and 1]); |
||
3475 | end; |
||
3476 | 8: |
||
3477 | begin |
||
3478 | with Ave do |
||
3479 | PByte(DestP)^ := ((cR + cG + cB) div c) div 3; |
||
3480 | Inc(PByte(DestP)); |
||
3481 | end; |
||
3482 | 16: |
||
3483 | begin |
||
3484 | with Ave do |
||
3485 | PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c); |
||
3486 | Inc(PWORD(DestP)); |
||
3487 | end; |
||
3488 | 24: |
||
3489 | begin |
||
3490 | with PBGR(DestP)^, Ave do |
||
3491 | begin |
||
3492 | R := cR div c; |
||
3493 | G := cG div c; |
||
3494 | B := cB div c; |
||
1 | daniel-mar | 3495 | end; |
4 | daniel-mar | 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; |
||
1 | daniel-mar | 3504 | end; |
3505 | end; |
||
3506 | |||
3507 | UpdateProgress(y); |
||
3508 | end; |
||
3509 | finally |
||
3510 | FreeMem(AveX); |
||
3511 | end; |
||
3512 | end; |
||
3513 | |||
3514 | var |
||
3515 | i, j: Integer; |
||
3516 | begin |
||
4 | daniel-mar | 3517 | if Empty or (Radius = 0) then Exit; |
1 | daniel-mar | 3518 | |
3519 | Radius := Abs(Radius); |
||
3520 | |||
3521 | StartProgress('Blur'); |
||
3522 | try |
||
3523 | Temp := TDIB.Create; |
||
3524 | try |
||
3525 | Temp.Assign(Self); |
||
3526 | SetSize(Width, Height, ABitCount); |
||
3527 | |||
4 | daniel-mar | 3528 | if ABitCount <= 8 then |
1 | daniel-mar | 3529 | begin |
3530 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
||
4 | daniel-mar | 3531 | for i := 0 to (1 shl ABitCount) - 1 do |
1 | daniel-mar | 3532 | begin |
4 | daniel-mar | 3533 | j := i * (1 shl (8 - ABitCount)); |
1 | daniel-mar | 3534 | j := j or (j shr ABitCount); |
3535 | ColorTable[i] := RGBQuad(j, j, j); |
||
3536 | end; |
||
3537 | UpdatePalette; |
||
3538 | end; |
||
3539 | |||
3540 | Blur_Radius_Other; |
||
3541 | finally |
||
3542 | Temp.Free; |
||
3543 | end; |
||
3544 | finally |
||
3545 | EndProgress; |
||
3546 | end; |
||
3547 | end; |
||
3548 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 3607 | procedure TDIB.Greyscale(ABitCount: Integer); |
3608 | var |
||
3609 | YTblR, YTblG, YTblB: array[0..255] of Byte; |
||
3610 | i, j, x, y: Integer; |
||
3611 | c: DWORD; |
||
3612 | R, G, B: Byte; |
||
3613 | Temp: TDIB; |
||
3614 | DestP, SrcP: Pointer; |
||
3615 | P: PByte; |
||
3616 | begin |
||
4 | daniel-mar | 3617 | if Empty then Exit; |
1 | daniel-mar | 3618 | |
3619 | Temp := TDIB.Create; |
||
3620 | try |
||
3621 | Temp.Assign(Self); |
||
3622 | SetSize(Width, Height, ABitCount); |
||
3623 | |||
4 | daniel-mar | 3624 | if ABitCount <= 8 then |
1 | daniel-mar | 3625 | begin |
3626 | FillChar(ColorTable, SizeOf(ColorTable), 0); |
||
4 | daniel-mar | 3627 | for i := 0 to (1 shl ABitCount) - 1 do |
1 | daniel-mar | 3628 | begin |
4 | daniel-mar | 3629 | j := i * (1 shl (8 - ABitCount)); |
1 | daniel-mar | 3630 | j := j or (j shr ABitCount); |
3631 | ColorTable[i] := RGBQuad(j, j, j); |
||
3632 | end; |
||
3633 | UpdatePalette; |
||
3634 | end; |
||
3635 | |||
4 | daniel-mar | 3636 | for i := 0 to 255 do |
1 | daniel-mar | 3637 | begin |
4 | daniel-mar | 3638 | YTblR[i] := Trunc(0.3588 * i); |
3639 | YTblG[i] := Trunc(0.4020 * i); |
||
3640 | YTblB[i] := Trunc(0.2392 * i); |
||
1 | daniel-mar | 3641 | end; |
3642 | |||
3643 | c := 0; |
||
3644 | |||
3645 | StartProgress('Greyscale'); |
||
3646 | try |
||
4 | daniel-mar | 3647 | for y := 0 to Height - 1 do |
1 | daniel-mar | 3648 | begin |
3649 | DestP := ScanLine[y]; |
||
3650 | SrcP := Temp.ScanLine[y]; |
||
3651 | |||
4 | daniel-mar | 3652 | for x := 0 to Width - 1 do |
1 | daniel-mar | 3653 | begin |
3654 | case Temp.BitCount of |
||
4 | daniel-mar | 3655 | 1: |
3656 | begin |
||
3657 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do |
||
3658 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
||
3659 | end; |
||
3660 | 4: |
||
3661 | begin |
||
3662 | with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do |
||
3663 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
||
3664 | end; |
||
3665 | 8: |
||
3666 | begin |
||
3667 | with Temp.ColorTable[PByte(SrcP)^] do |
||
3668 | c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue]; |
||
3669 | Inc(PByte(SrcP)); |
||
3670 | end; |
||
3671 | 16: |
||
3672 | begin |
||
3673 | pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B); |
||
3674 | c := YTblR[R] + YTblR[G] + YTblR[B]; |
||
3675 | Inc(PWord(SrcP)); |
||
3676 | end; |
||
3677 | 24: |
||
3678 | begin |
||
3679 | with PBGR(SrcP)^ do |
||
3680 | c := YTblR[R] + YTblG[G] + YTblB[B]; |
||
3681 | Inc(PBGR(SrcP)); |
||
3682 | end; |
||
3683 | 32: |
||
3684 | begin |
||
3685 | pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B); |
||
3686 | c := YTblR[R] + YTblR[G] + YTblR[B]; |
||
3687 | Inc(PDWORD(SrcP)); |
||
3688 | end; |
||
1 | daniel-mar | 3689 | end; |
3690 | |||
3691 | case BitCount of |
||
4 | daniel-mar | 3692 | 1: |
3693 | begin |
||
3694 | P := @PArrayByte(DestP)[X shr 3]; |
||
3695 | P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c > 127)) shl Shift1[X and 7]); |
||
3696 | end; |
||
3697 | 4: |
||
3698 | begin |
||
3699 | P := @PArrayByte(DestP)[X shr 1]; |
||
3700 | P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]); |
||
3701 | end; |
||
3702 | 8: |
||
3703 | begin |
||
3704 | PByte(DestP)^ := c; |
||
3705 | Inc(PByte(DestP)); |
||
3706 | end; |
||
3707 | 16: |
||
3708 | begin |
||
3709 | PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
||
3710 | Inc(PWord(DestP)); |
||
3711 | end; |
||
3712 | 24: |
||
3713 | begin |
||
3714 | with PBGR(DestP)^ do |
||
3715 | begin |
||
3716 | R := c; |
||
3717 | G := c; |
||
3718 | B := c; |
||
1 | daniel-mar | 3719 | end; |
4 | daniel-mar | 3720 | Inc(PBGR(DestP)); |
3721 | end; |
||
3722 | 32: |
||
3723 | begin |
||
3724 | PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c); |
||
3725 | Inc(PDWORD(DestP)); |
||
3726 | end; |
||
1 | daniel-mar | 3727 | end; |
3728 | end; |
||
3729 | |||
3730 | UpdateProgress(y); |
||
3731 | end; |
||
3732 | finally |
||
3733 | EndProgress; |
||
3734 | end; |
||
3735 | finally |
||
3736 | Temp.Free; |
||
3737 | end; |
||
3738 | end; |
||
3739 | |||
4 | daniel-mar | 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 | |||
3797 | function TDIB.IntToColor(i: Integer): TBGR; |
||
3798 | begin |
||
3799 | Result.b := i shr 16; |
||
3800 | Result.g := i shr 8; |
||
3801 | Result.r := i; |
||
3802 | end; |
||
3803 | |||
3804 | function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; |
||
3805 | begin |
||
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 |
||
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; |
||
3827 | |||
3828 | procedure TDIB.Contrast(Amount: Integer); |
||
1 | daniel-mar | 3829 | var |
4 | daniel-mar | 3830 | x, y: Integer; |
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; |
||
1 | daniel-mar | 3838 | begin |
4 | daniel-mar | 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 |
||
3877 | begin |
||
3878 | case BitCount of |
||
3879 | 24, 16: D := ScanLine[y]; |
||
3880 | 8, 4: |
||
3881 | begin |
||
3882 | D := Temp1.ScanLine[y]; |
||
3883 | S := Temp1.ScanLine[y]; |
||
3884 | end; |
||
3885 | else |
||
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 |
||
3906 | with Temp1.ColorTable[PByte(S)^] do |
||
3907 | color := rgbRed + rgbGreen + rgbBlue; |
||
3908 | Inc(PByte(S)); |
||
3909 | PByte(D)^ := color; |
||
3910 | Inc(PByte(D)); |
||
3911 | end; |
||
3912 | 4: |
||
3913 | begin |
||
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; |
||
1 | daniel-mar | 3929 | |
4 | daniel-mar | 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 |
||
1 | daniel-mar | 3949 | begin |
4 | daniel-mar | 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; |
||
3965 | Temp1.Assign(self); |
||
3966 | Temp1.SetSize(Width, Height, BitCount); |
||
3967 | for i := 0 to 255 do |
||
1 | daniel-mar | 3968 | begin |
4 | daniel-mar | 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; |
||
3976 | end; |
||
3977 | UpdatePalette; |
||
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]; |
||
3987 | 8, 4: |
||
3988 | begin |
||
3989 | D := Temp1.ScanLine[y]; |
||
3990 | S := Temp1.ScanLine[y]; |
||
3991 | end; |
||
3992 | else |
||
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; |
||
1 | daniel-mar | 4038 | |
4 | daniel-mar | 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 |
||
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; |
||
1 | daniel-mar | 4079 | end; |
4 | daniel-mar | 4080 | UpdatePalette; |
1 | daniel-mar | 4081 | end; |
4 | daniel-mar | 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 |
||
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 |
||
1 | daniel-mar | 4096 | end; |
4 | daniel-mar | 4097 | for x := 0 to Pred(Width) do |
4098 | begin |
||
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; |
||
1 | daniel-mar | 4139 | |
4 | daniel-mar | 4140 | procedure TDIB.AddRGB(aR, aG, aB: Byte); |
4141 | var |
||
4142 | Table: array[0..255] of TBGR; |
||
4143 | x, y: Integer; |
||
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 |
||
4155 | 32: Exit; // I haven't bitmap of this type ! Sorry |
||
4156 | 24, 16: |
||
1 | daniel-mar | 4157 | begin |
4 | daniel-mar | 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 |
||
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; |
||
1 | daniel-mar | 4230 | |
4 | daniel-mar | 4231 | function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean; |
4232 | var |
||
4233 | Sum, r, g, b, x, y: Integer; |
||
4234 | a, i, j: byte; |
||
4235 | tmp: TBGR; |
||
4236 | Col: PBGR; |
||
4237 | D: Pointer; |
||
4238 | begin |
||
4239 | Result := True; |
||
4240 | Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] + |
||
4241 | Filter[0, 1] + Filter[1, 1] + Filter[2, 1] + |
||
4242 | Filter[0, 2] + Filter[1, 2] + Filter[2, 2]; |
||
4243 | if Sum = 0 then |
||
4244 | Sum := 1; |
||
4245 | Col := PBits; |
||
4246 | for y := 0 to Pred(Height) do |
||
4247 | begin |
||
4248 | D := Dest.ScanLine[y]; |
||
4249 | for x := 0 to Pred(Width) do |
||
4250 | begin |
||
4251 | r := 0; g := 0; b := 0; |
||
4252 | case BitCount of |
||
4253 | 32, 16, 4, 1: |
||
4254 | begin |
||
4255 | Result := False; |
||
4256 | Exit; |
||
4257 | end; |
||
4258 | 24: |
||
4259 | begin |
||
4260 | for i := 0 to 2 do |
||
4261 | begin |
||
4262 | for j := 0 to 2 do |
||
4263 | begin |
||
4264 | Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
||
4265 | Interval(0, Pred(Height), y + Pred(j), True)]); |
||
4266 | Inc(b, Filter[i, j] * Tmp.b); |
||
4267 | Inc(g, Filter[i, j] * Tmp.g); |
||
4268 | Inc(r, Filter[i, j] * Tmp.r); |
||
1 | daniel-mar | 4269 | end; |
4 | daniel-mar | 4270 | end; |
4271 | Col.b := IntToByte(b div Sum); |
||
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 |
||
4280 | for j := 0 to 2 do |
||
4281 | begin |
||
4282 | a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True), |
||
4283 | Interval(0, Pred(Height), y + Pred(j), True)]); |
||
4284 | tmp.r := ColorTable[a].rgbRed; |
||
4285 | tmp.g := ColorTable[a].rgbGreen; |
||
4286 | tmp.b := ColorTable[a].rgbBlue; |
||
4287 | Inc(b, Filter[i, j] * Tmp.b); |
||
4288 | Inc(g, Filter[i, j] * Tmp.g); |
||
4289 | Inc(r, Filter[i, j] * Tmp.r); |
||
1 | daniel-mar | 4290 | end; |
4 | daniel-mar | 4291 | end; |
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); |
||
4296 | Inc(PByte(D)); |
||
4297 | end; |
||
4298 | end; |
||
4299 | end; |
||
4300 | end; |
||
4301 | end; |
||
1 | daniel-mar | 4302 | |
4 | daniel-mar | 4303 | procedure TDIB.Spray(Amount: Integer); |
4304 | var |
||
4305 | value, x, y: Integer; |
||
4306 | D: Pointer; |
||
4307 | color: DWORD; |
||
4308 | P: PByte; |
||
4309 | begin |
||
4310 | for y := Pred(Height) downto 0 do |
||
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; |
||
4332 | Inc(PWord(D)); |
||
4333 | end; |
||
4334 | 8: |
||
4335 | begin |
||
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 |
||
1 | daniel-mar | 4350 | end; |
4351 | end; |
||
4 | daniel-mar | 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: |
||
4375 | begin |
||
4376 | Temp1 := TDIB.Create; |
||
4377 | Temp1.Assign(self); |
||
4378 | Temp1.SetSize(Width, Height, bitCount); |
||
4379 | end; |
||
4380 | 8: |
||
4381 | begin |
||
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); |
||
4422 | |||
4423 | end; |
||
4424 | end; |
||
4425 | Temp1.UpdatePalette; |
||
4426 | end; |
||
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; |
||
4471 | UpdatePalette; |
||
4472 | end; |
||
4473 | end; |
||
4474 | for y := 0 to Pred(Height) do |
||
1 | daniel-mar | 4475 | begin |
4 | daniel-mar | 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; |
||
4518 | end; |
||
4519 | end; |
||
4520 | end; |
||
4521 | case BitCount of |
||
4522 | 24, 8: |
||
1 | daniel-mar | 4523 | begin |
4 | daniel-mar | 4524 | Assign(Temp1); |
4525 | Temp1.Free; |
||
4526 | end; |
||
4527 | 4: Temp1.Free; |
||
4528 | end; |
||
4529 | FreeMem(pc, SizeOf(TBGR)); |
||
4530 | end; |
||
1 | daniel-mar | 4531 | |
4 | daniel-mar | 4532 | procedure TDIB.Emboss; |
4533 | var |
||
4534 | x, y: longint; |
||
4535 | D, D1, P: pointer; |
||
4536 | color: TBGR; |
||
4537 | c: DWORD; |
||
4538 | P1: PByte; |
||
4539 | |||
4540 | begin |
||
4541 | D := nil; |
||
4542 | D1 := nil; |
||
4543 | P := nil; |
||
4544 | case BitCount of |
||
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]; |
||
1 | daniel-mar | 4559 | end; |
4 | daniel-mar | 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; |
||
1 | daniel-mar | 4609 | |
4 | daniel-mar | 4610 | procedure TDIB.AddMonoNoise(Amount: Integer); |
4611 | var |
||
4612 | value: cardinal; |
||
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 |
||
4620 | begin |
||
4621 | D := ScanLine[y]; |
||
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; |
||
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 |
||
1 | daniel-mar | 4657 | end; |
4658 | end; |
||
4659 | end; |
||
4660 | end; |
||
4661 | |||
4 | daniel-mar | 4662 | procedure TDIB.AddGradiantNoise(Amount: byte); |
1 | daniel-mar | 4663 | var |
4 | daniel-mar | 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 | |||
1 | daniel-mar | 4672 | begin |
4 | daniel-mar | 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: |
||
4679 | begin |
||
4680 | for i := 0 to 255 do |
||
4681 | begin |
||
4682 | a := Random(Amount); |
||
4683 | Table[i].b := IntToByte(i + a); |
||
4684 | Table[i].g := IntToByte(i + a); |
||
4685 | Table[i].r := IntToByte(i + a); |
||
4686 | 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; |
||
4704 | UpdatePalette; |
||
4705 | end; |
||
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 |
||
4711 | begin |
||
4712 | case BitCount of |
||
4713 | 24: D := ScanLine[y]; |
||
4714 | 8, 4: |
||
4715 | begin |
||
4716 | D := Temp1.ScanLine[y]; |
||
4717 | S := Temp1.ScanLine[y]; |
||
4718 | end; |
||
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: |
||
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)); |
||
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]); |
||
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; |
||
1 | daniel-mar | 4758 | |
4 | daniel-mar | 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 |
||
1 | daniel-mar | 4781 | begin |
4 | daniel-mar | 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 |
||
1 | daniel-mar | 4788 | begin |
4 | daniel-mar | 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; |
||
1 | daniel-mar | 4797 | end; |
4 | daniel-mar | 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; |
||
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 |
||
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; |
||
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; |
||
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; |
||
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 |
||
1 | daniel-mar | 4898 | begin |
4 | daniel-mar | 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) |
||
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] |
||
4944 | else |
||
4945 | sli := ScanLine[Height - ifrom_y - iy]; |
||
4946 | if ifrom_x + ix < Width then |
||
4947 | begin |
||
4948 | new_red := sli^[ifrom_x + ix].r; |
||
4949 | new_green := sli^[ifrom_x + ix].g; |
||
4950 | new_blue := sli^[ifrom_x + ix].b; |
||
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; |
||
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; |
||
1 | daniel-mar | 4979 | |
4 | daniel-mar | 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; |
||
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]; |
||
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: |
||
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; |
||
1 | daniel-mar | 5059 | |
4 | daniel-mar | 5060 | procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer); |
5061 | var |
||
5062 | i: Integer; |
||
5063 | begin |
||
5064 | for i := 1 to Amount do |
||
5065 | Bmp.SplitBlur(i); |
||
5066 | end; |
||
1 | daniel-mar | 5067 | |
4 | daniel-mar | 5068 | procedure TDIB.SplitBlur(Amount: Integer); |
5069 | var |
||
5070 | Lin1, Lin2: PLines; |
||
5071 | cx, x, y: Integer; |
||
5072 | Buf: array[0..3] of TBGR; |
||
5073 | D: Pointer; |
||
1 | daniel-mar | 5074 | |
4 | daniel-mar | 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 |
||
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)); |
||
5096 | end; |
||
5097 | end; |
||
5098 | end; |
||
1 | daniel-mar | 5099 | |
4 | daniel-mar | 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; |
||
1 | daniel-mar | 5117 | |
4 | daniel-mar | 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); |
||
1 | daniel-mar | 5130 | end; |
5131 | end; |
||
4 | daniel-mar | 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; |
||
1 | daniel-mar | 5253 | end; |
5254 | |||
4 | daniel-mar | 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 | |||
1 | daniel-mar | 5308 | { TCustomDXDIB } |
5309 | |||
5310 | constructor TCustomDXDIB.Create(AOnwer: TComponent); |
||
5311 | begin |
||
5312 | inherited Create(AOnwer); |
||
5313 | FDIB := TDIB.Create; |
||
5314 | end; |
||
5315 | |||
5316 | destructor TCustomDXDIB.Destroy; |
||
5317 | begin |
||
5318 | FDIB.Free; |
||
5319 | inherited Destroy; |
||
5320 | end; |
||
5321 | |||
5322 | procedure TCustomDXDIB.SetDIB(Value: TDIB); |
||
5323 | begin |
||
5324 | FDIB.Assign(Value); |
||
5325 | end; |
||
5326 | |||
5327 | { TCustomDXPaintBox } |
||
5328 | |||
5329 | constructor TCustomDXPaintBox.Create(AOwner: TComponent); |
||
5330 | begin |
||
5331 | inherited Create(AOwner); |
||
5332 | FDIB := TDIB.Create; |
||
5333 | |||
5334 | ControlStyle := ControlStyle + [csReplicatable]; |
||
5335 | Height := 105; |
||
5336 | Width := 105; |
||
5337 | end; |
||
5338 | |||
5339 | destructor TCustomDXPaintBox.Destroy; |
||
5340 | begin |
||
5341 | FDIB.Free; |
||
5342 | inherited Destroy; |
||
5343 | end; |
||
5344 | |||
5345 | function TCustomDXPaintBox.GetPalette: HPALETTE; |
||
5346 | begin |
||
5347 | Result := FDIB.Palette; |
||
5348 | end; |
||
5349 | |||
5350 | procedure TCustomDXPaintBox.Paint; |
||
5351 | |||
5352 | procedure Draw2(Width, Height: Integer); |
||
5353 | begin |
||
4 | daniel-mar | 5354 | if (Width <> FDIB.Width) or (Height <> FDIB.Height) then |
1 | daniel-mar | 5355 | begin |
5356 | if FCenter then |
||
5357 | begin |
||
4 | daniel-mar | 5358 | inherited Canvas.StretchDraw(Bounds(-(Width - ClientWidth) div 2, |
5359 | -(Height - ClientHeight) div 2, Width, Height), FDIB); |
||
5360 | end |
||
5361 | else |
||
1 | daniel-mar | 5362 | begin |
5363 | inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB); |
||
5364 | end; |
||
4 | daniel-mar | 5365 | end |
5366 | else |
||
1 | daniel-mar | 5367 | begin |
5368 | if FCenter then |
||
5369 | begin |
||
4 | daniel-mar | 5370 | inherited Canvas.Draw(-(Width - ClientWidth) div 2, -(Height - ClientHeight) div 2, |
1 | daniel-mar | 5371 | FDIB); |
4 | daniel-mar | 5372 | end |
5373 | else |
||
1 | daniel-mar | 5374 | begin |
5375 | inherited Canvas.Draw(0, 0, FDIB); |
||
5376 | end; |
||
5377 | end; |
||
5378 | end; |
||
5379 | |||
5380 | var |
||
5381 | r, r2: Single; |
||
5382 | ViewWidth2, ViewHeight2: Integer; |
||
5383 | begin |
||
5384 | inherited Paint; |
||
5385 | |||
5386 | with inherited Canvas do |
||
5387 | begin |
||
5388 | if (csDesigning in ComponentState) then |
||
5389 | begin |
||
5390 | Pen.Style := psDash; |
||
5391 | Brush.Style := bsClear; |
||
5392 | Rectangle(0, 0, Width, Height); |
||
5393 | end; |
||
5394 | |||
5395 | if FDIB.Empty then Exit; |
||
5396 | |||
4 | daniel-mar | 5397 | if (FViewWidth > 0) or (FViewHeight > 0) then |
1 | daniel-mar | 5398 | begin |
5399 | ViewWidth2 := FViewWidth; |
||
4 | daniel-mar | 5400 | if ViewWidth2 = 0 then ViewWidth2 := FDIB.Width; |
1 | daniel-mar | 5401 | ViewHeight2 := FViewHeight; |
4 | daniel-mar | 5402 | if ViewHeight2 = 0 then ViewHeight2 := FDIB.Height; |
1 | daniel-mar | 5403 | |
5404 | if FAutoStretch then |
||
5405 | begin |
||
4 | daniel-mar | 5406 | if (ClientWidth < ViewWidth2) or (ClientHeight < ViewHeight2) then |
1 | daniel-mar | 5407 | begin |
4 | daniel-mar | 5408 | r := ViewWidth2 / ClientWidth; |
5409 | r2 := ViewHeight2 / ClientHeight; |
||
5410 | if r > r2 then |
||
1 | daniel-mar | 5411 | r := r2; |
4 | daniel-mar | 5412 | Draw2(Round(r * ClientWidth), Round(r * ClientHeight)); |
5413 | end |
||
5414 | else |
||
1 | daniel-mar | 5415 | Draw2(ViewWidth2, ViewHeight2); |
4 | daniel-mar | 5416 | end |
5417 | else |
||
1 | daniel-mar | 5418 | Draw2(ViewWidth2, ViewHeight2); |
4 | daniel-mar | 5419 | end |
5420 | else |
||
1 | daniel-mar | 5421 | begin |
5422 | if FAutoStretch then |
||
5423 | begin |
||
4 | daniel-mar | 5424 | if (FDIB.Width > ClientWidth) or (FDIB.Height > ClientHeight) then |
1 | daniel-mar | 5425 | begin |
4 | daniel-mar | 5426 | r := ClientWidth / FDIB.Width; |
5427 | r2 := ClientHeight / FDIB.Height; |
||
5428 | if r > r2 then |
||
1 | daniel-mar | 5429 | r := r2; |
4 | daniel-mar | 5430 | Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
5431 | end |
||
5432 | else |
||
1 | daniel-mar | 5433 | Draw2(FDIB.Width, FDIB.Height); |
4 | daniel-mar | 5434 | end |
5435 | else |
||
5436 | if FStretch then |
||
1 | daniel-mar | 5437 | begin |
4 | daniel-mar | 5438 | if FKeepAspect then |
5439 | begin |
||
5440 | r := ClientWidth / FDIB.Width; |
||
5441 | r2 := ClientHeight / FDIB.Height; |
||
5442 | if r > r2 then |
||
5443 | r := r2; |
||
5444 | Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height)); |
||
5445 | end |
||
5446 | else |
||
5447 | Draw2(ClientWidth, ClientHeight); |
||
5448 | end |
||
5449 | else |
||
5450 | Draw2(FDIB.Width, FDIB.Height); |
||
1 | daniel-mar | 5451 | end; |
5452 | end; |
||
5453 | end; |
||
5454 | |||
5455 | procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean); |
||
5456 | begin |
||
4 | daniel-mar | 5457 | if FAutoStretch <> Value then |
1 | daniel-mar | 5458 | begin |
5459 | FAutoStretch := Value; |
||
5460 | Invalidate; |
||
5461 | end; |
||
5462 | end; |
||
5463 | |||
5464 | procedure TCustomDXPaintBox.SetCenter(Value: Boolean); |
||
5465 | begin |
||
4 | daniel-mar | 5466 | if FCenter <> Value then |
1 | daniel-mar | 5467 | begin |
5468 | FCenter := Value; |
||
5469 | Invalidate; |
||
5470 | end; |
||
5471 | end; |
||
5472 | |||
5473 | procedure TCustomDXPaintBox.SetDIB(Value: TDIB); |
||
5474 | begin |
||
4 | daniel-mar | 5475 | if FDIB <> Value then |
1 | daniel-mar | 5476 | begin |
5477 | FDIB.Assign(Value); |
||
5478 | Invalidate; |
||
5479 | end; |
||
5480 | end; |
||
5481 | |||
5482 | procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean); |
||
5483 | begin |
||
4 | daniel-mar | 5484 | if Value <> FKeepAspect then |
1 | daniel-mar | 5485 | begin |
5486 | FKeepAspect := Value; |
||
5487 | Invalidate; |
||
5488 | end; |
||
5489 | end; |
||
5490 | |||
5491 | procedure TCustomDXPaintBox.SetStretch(Value: Boolean); |
||
5492 | begin |
||
4 | daniel-mar | 5493 | if Value <> FStretch then |
1 | daniel-mar | 5494 | begin |
5495 | FStretch := Value; |
||
5496 | Invalidate; |
||
5497 | end; |
||
5498 | end; |
||
5499 | |||
5500 | procedure TCustomDXPaintBox.SetViewWidth(Value: Integer); |
||
5501 | begin |
||
4 | daniel-mar | 5502 | if Value < 0 then Value := 0; |
5503 | if Value <> FViewWidth then |
||
1 | daniel-mar | 5504 | begin |
5505 | FViewWidth := Value; |
||
5506 | Invalidate; |
||
5507 | end; |
||
5508 | end; |
||
5509 | |||
5510 | procedure TCustomDXPaintBox.SetViewHeight(Value: Integer); |
||
5511 | begin |
||
4 | daniel-mar | 5512 | if Value < 0 then Value := 0; |
5513 | if Value <> FViewHeight then |
||
1 | daniel-mar | 5514 | begin |
5515 | FViewHeight := Value; |
||
5516 | Invalidate; |
||
5517 | end; |
||
5518 | end; |
||
5519 | |||
4 | daniel-mar | 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 diff‚rence n‚gative*) |
||
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 | |||
1 | daniel-mar | 9896 | initialization |
9897 | TPicture.RegisterClipBoardFormat(CF_DIB, TDIB); |
||
9898 | TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB); |
||
9899 | finalization |
||
9900 | TPicture.UnRegisterGraphicClass(TDIB); |
||
9901 | |||
9902 | FEmptyDIBImage.Free; |
||
9903 | FPaletteManager.Free; |
||
4 | daniel-mar | 9904 | end. |