WebSVN – spacemission – Blame – /VCL_DELPHIX_D6/DIB.pas

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,
16	daniel-mar	31	{$IFDEF VER7UP} Types, {$ENDIF}
		32	{$IFDEF VER9UP} GraphUtil, {$ENDIF}
		33	{$IFDEF VER17UP} UITypes,{$ENDIF}
4	daniel-mar	34	Math;
1	daniel-mar	35
		36	type
4	daniel-mar	37	TColorLineStyle = (csSolid, csGradient, csRainbow);
		38	TColorLinePixelGeometry = (pgPoint, pgCircular, pgRectangular);
		39	PRGBQuads = ^TRGBQuads;
1	daniel-mar	40	TRGBQuads = array[0..255] of TRGBQuad;
		41
		42	TPaletteEntries = array[0..255] of TPaletteEntry;
		43
16	daniel-mar	44	PBGRA = ^TBGRA;
		45	TBGRA = packed record
		46	B, G, R, A: Byte;
		47	end;
		48	TLinesA = array[0..0] of TBGRA;
		49	PLinesA = ^TLinesA;
		50
1	daniel-mar	51	PBGR = ^TBGR;
		52	TBGR = packed record
		53	B, G, R: Byte;
		54	end;
		55
4	daniel-mar	56	{ Added this type for New SPecial Effect }
		57	TFilter = array[0..2, 0..2] of SmallInt;
		58	TLines = array[0..0] of TBGR;
		59	PLines = ^TLines;
		60	TBytes = array[0..0] of Byte;
		61	PBytes = ^TBytes;
		62	TPBytes = array[0..0] of PBytes;
		63	PPBytes = ^TPBytes;
		64	{ End of type's }
		65
1	daniel-mar	66	PArrayBGR = ^TArrayBGR;
16	daniel-mar	67	TArrayBGR = array[0..0] of TBGR;
1	daniel-mar	68
		69	PArrayByte = ^TArrayByte;
16	daniel-mar	70	TArrayByte = array[0..0] of Byte;
1	daniel-mar	71
		72	PArrayWord = ^TArrayWord;
16	daniel-mar	73	TArrayWord = array[0..0] of Word;
1	daniel-mar	74
		75	PArrayDWord = ^TArrayDWord;
16	daniel-mar	76	TArrayDWord = array[0..0] of DWord;
1	daniel-mar	77
4	daniel-mar	78	{ TDIBPixelFormat }
1	daniel-mar	79
		80	TDIBPixelFormat = record
		81	RBitMask, GBitMask, BBitMask: DWORD;
		82	RBitCount, GBitCount, BBitCount: DWORD;
		83	RShift, GShift, BShift: DWORD;
		84	RBitCount2, GBitCount2, BBitCount2: DWORD;
		85	end;
		86
4	daniel-mar	87	{ TDIBSharedImage }
		88
1	daniel-mar	89	TDIBSharedImage = class(TSharedImage)
4	daniel-mar	90	private
1	daniel-mar	91	FBitCount: Integer;
		92	FBitmapInfo: PBitmapInfo;
		93	FBitmapInfoSize: Integer;
		94	FChangePalette: Boolean;
		95	FColorTable: TRGBQuads;
		96	FColorTablePos: Integer;
		97	FCompressed: Boolean;
		98	FDC: THandle;
		99	FHandle: THandle;
		100	FHeight: Integer;
		101	FMemoryImage: Boolean;
		102	FNextLine: Integer;
		103	FOldHandle: THandle;
		104	FPalette: HPalette;
		105	FPaletteCount: Integer;
		106	FPBits: Pointer;
		107	FPixelFormat: TDIBPixelFormat;
		108	FSize: Integer;
		109	FTopPBits: Pointer;
		110	FWidth: Integer;
		111	FWidthBytes: Integer;
		112	constructor Create;
		113	procedure NewImage(AWidth, AHeight, ABitCount: Integer;
		114	const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
4	daniel-mar	115	procedure Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean); {$IFDEF VER9UP}inline;{$ENDIF}
1	daniel-mar	116	procedure Compress(Source: TDIBSharedImage);
		117	procedure Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
		118	procedure ReadData(Stream: TStream; MemoryImage: Boolean);
		119	function GetPalette: THandle;
		120	procedure SetColorTable(const Value: TRGBQuads);
		121	protected
		122	procedure FreeHandle; override;
		123	public
		124	destructor Destroy; override;
		125	end;
		126
4	daniel-mar	127	{ TFilterTypeResample }
		128
		129	TFilterTypeResample = (ftrBox, ftrTriangle, ftrHermite, ftrBell, ftrBSpline,
		130	ftrLanczos3, ftrMitchell);
		131
		132	TDistortType = (dtFast, dtSlow);
		133	{DXFusion effect type}
		134	TFilterMode = (fmNormal, fmMix50, fmMix25, fmMix75);
		135
		136	{ TLightSource }
		137
		138	TLightSource = record
		139	X, Y: Integer;
		140	Size1, Size2: Integer;
		141	Color: TColor;
		142	end;
		143
		144	{ TLightArray }
		145
16	daniel-mar	146	TLightArray = array{$IFNDEF VER4UP}[0..0]{$ENDIF} of TLightsource;
4	daniel-mar	147
		148	{ TMatrixSetting }
		149
		150	TMatrixSetting = array[0..9] of Integer;
		151
		152	{ TDIB }
		153
1	daniel-mar	154	TDIB = class(TGraphic)
		155	private
		156	FCanvas: TCanvas;
4	daniel-mar	157	FImage: TDIBSharedImage;
1	daniel-mar	158
		159	FProgressName: string;
		160	FProgressOldY: DWORD;
		161	FProgressOldTime: DWORD;
		162	FProgressOld: DWORD;
		163	FProgressY: DWORD;
		164	{ For speed-up }
		165	FBitCount: Integer;
		166	FHeight: Integer;
		167	FNextLine: Integer;
		168	FNowPixelFormat: TDIBPixelFormat;
		169	FPBits: Pointer;
		170	FSize: Integer;
		171	FTopPBits: Pointer;
		172	FWidth: Integer;
		173	FWidthBytes: Integer;
4	daniel-mar	174	FLUTDist: array[0..255, 0..255] of Integer;
		175	LG_COUNT: Integer;
		176	LG_DETAIL: Integer;
		177	FFreeList: TList;
1	daniel-mar	178	procedure AllocHandle;
		179	procedure CanvasChanging(Sender: TObject);
		180	procedure Changing(MemoryImage: Boolean);
		181	procedure ConvertBitCount(ABitCount: Integer);
		182	function GetBitmapInfo: PBitmapInfo;
		183	function GetBitmapInfoSize: Integer;
		184	function GetCanvas: TCanvas;
		185	function GetHandle: THandle;
		186	function GetPaletteCount: Integer;
		187	function GetPixel(X, Y: Integer): DWORD;
		188	function GetPBits: Pointer;
		189	function GetPBitsReadOnly: Pointer;
		190	function GetScanLine(Y: Integer): Pointer;
		191	function GetScanLineReadOnly(Y: Integer): Pointer;
		192	function GetTopPBits: Pointer;
		193	function GetTopPBitsReadOnly: Pointer;
		194	procedure SetBitCount(Value: Integer);
4	daniel-mar	195	procedure SetImage(Value: TDIBSharedImage); {$IFDEF VER9UP}inline;{$ENDIF}
1	daniel-mar	196	procedure SetNowPixelFormat(const Value: TDIBPixelFormat);
		197	procedure SetPixel(X, Y: Integer; Value: DWORD);
		198	procedure StartProgress(const Name: string);
		199	procedure EndProgress;
		200	procedure UpdateProgress(PercentY: Integer);
4	daniel-mar	201
		202	{ Added these 3 functions for New Specials Effects }
		203	function Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		204	function IntToByte(i: Integer): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
		205	function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		206	{ End of 3 functions for New Special Effect }
		207
		208	procedure Darkness(Amount: Integer);
		209	function GetAlphaChannel: TDIB;
		210	procedure SetAlphaChannel(const Value: TDIB);
		211	function GetClientRect: TRect;
		212	function GetRGBChannel: TDIB;
		213	procedure SetRGBChannel(const Value: TDIB);
1	daniel-mar	214	protected
		215	procedure DefineProperties(Filer: TFiler); override;
4	daniel-mar	216	procedure Draw(ACanvas: TCanvas; const ARect: TRect); override;
1	daniel-mar	217	function GetEmpty: Boolean; override;
		218	function GetHeight: Integer; override;
		219	function GetPalette: HPalette; override;
		220	function GetWidth: Integer; override;
		221	procedure ReadData(Stream: TStream); override;
		222	procedure SetHeight(Value: Integer); override;
		223	procedure SetPalette(Value: HPalette); override;
		224	procedure SetWidth(Value: Integer); override;
		225	procedure WriteData(Stream: TStream); override;
16	daniel-mar	226	{$IFDEF VER16UP}
		227	function GetSupportsPartialTransparency: Boolean; override;
		228	{$ENDIF}
		229	function GetTransparent: Boolean; override;
1	daniel-mar	230	public
		231	ColorTable: TRGBQuads;
		232	PixelFormat: TDIBPixelFormat;
		233	constructor Create; override;
		234	destructor Destroy; override;
		235	procedure Assign(Source: TPersistent); override;
		236	procedure Clear;
		237	procedure Compress;
		238	procedure Decompress;
		239	procedure FreeHandle;
4	daniel-mar	240	function HasAlphaChannel: Boolean;
		241	function AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
		242	procedure RetAlphaChannel(out oDIB: TDIB);
1	daniel-mar	243	procedure LoadFromClipboardFormat(AFormat: Word; AData: THandle;
		244	APalette: HPALETTE); override;
		245	procedure LoadFromStream(Stream: TStream); override;
		246	procedure SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
		247	var APalette: HPALETTE); override;
		248	procedure SaveToStream(Stream: TStream); override;
4	daniel-mar	249	procedure SetSize(AWidth, AHeight, ABitCount: Integer); {$IFDEF VER5UP}reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
1	daniel-mar	250	procedure UpdatePalette;
		251	{ Special effect }
		252	procedure Blur(ABitCount: Integer; Radius: Integer);
		253	procedure Greyscale(ABitCount: Integer);
		254	procedure Mirror(MirrorX, MirrorY: Boolean);
16	daniel-mar	255	procedure Negative; {$IFDEF VER9UP}inline;{$ENDIF}
1	daniel-mar	256
4	daniel-mar	257	{ Added New Special Effect }
		258	procedure Spray(Amount: Integer);
		259	procedure Emboss;
		260	procedure AddMonoNoise(Amount: Integer);
		261	procedure AddGradiantNoise(Amount: byte);
		262	function Twist(bmp: TDIB; Amount: byte): Boolean;
		263	function FishEye(bmp: TDIB): Boolean;
		264	function SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
		265	procedure Lightness(Amount: Integer);
		266	procedure Saturation(Amount: Integer);
		267	procedure Contrast(Amount: Integer);
		268	procedure AddRGB(aR, aG, aB: Byte);
		269	function Filter(Dest: TDIB; Filter: TFilter): Boolean;
		270	procedure Sharpen(Amount: Integer);
		271	function IntToColor(i: Integer): TBGR; {$IFDEF VER9UP}inline;{$ENDIF}
		272	function Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
		273	procedure SplitBlur(Amount: Integer);
		274	procedure GaussianBlur(Bmp: TDIB; Amount: Integer);
		275	{ End of New Special Effect }
		276	{
		277	New effect for TDIB
		278	with Some Effects like AntiAlias, Contrast,
		279	Lightness, Saturation, GaussianBlur, Mosaic,
		280	Twist, Splitlight, Trace, Emboss, etc.
		281	Works with 24bit color DIBs.
		282
		283	This component is based on TProEffectImage component version 1.0 by
		284	Written By Babak Sateli (babak_sateli@yahoo.com, http://raveland.netfirms.com)
		285
		286	and modified by (c) 2004 Jaro Benes
		287	for DelphiX use.
		288
		289	Demo was modified into DXForm with function like original
		290
		291	DISCLAIMER
		292	This component is provided AS-IS without any warranty of any kind, either express or
		293	implied. This component is freeware and can be used in any software product.
		294	}
		295	procedure DoInvert;
		296	procedure DoAddColorNoise(Amount: Integer);
		297	procedure DoAddMonoNoise(Amount: Integer);
		298	procedure DoAntiAlias;
		299	procedure DoContrast(Amount: Integer);
		300	procedure DoFishEye(Amount: Integer);
		301	procedure DoGrayScale;
		302	procedure DoLightness(Amount: Integer);
		303	procedure DoDarkness(Amount: Integer);
		304	procedure DoSaturation(Amount: Integer);
		305	procedure DoSplitBlur(Amount: Integer);
		306	procedure DoGaussianBlur(Amount: Integer);
		307	procedure DoMosaic(Size: Integer);
		308	procedure DoTwist(Amount: Integer);
		309	procedure DoSplitlight(Amount: Integer);
		310	procedure DoTile(Amount: Integer);
		311	procedure DoSpotLight(Amount: Integer; Spot: TRect);
		312	procedure DoTrace(Amount: Integer);
		313	procedure DoEmboss;
		314	procedure DoSolorize(Amount: Integer);
		315	procedure DoPosterize(Amount: Integer);
		316	procedure DoBrightness(Amount: Integer);
		317	procedure DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
		318	{rotate}
		319	procedure DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
		320	procedure DoColorize(ForeColor, BackColor: TColor);
		321	{Simple explosion spoke effect}
16	daniel-mar	322	procedure DoNovaEffect(const sr, sg, sb, cx, cy, radius,
4	daniel-mar	323	nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
		324
		325	{Simple Mandelbrot-set drawing}
		326	procedure DrawMandelbrot(ao, au: Integer; bo, bu: Double);
		327
		328	{Sephia effect}
		329	procedure SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
		330
		331	{Simple blend pixel}
		332	procedure BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
		333	{Line in polar system}
		334	procedure LinePolar(x, y: Integer; AngleInDegree, Length: extended;
		335	Color: cardinal);
		336
		337	{special version Dark/Light procedure in percent}
		338	procedure Darker(Percent: Integer);
		339	procedure Lighter(Percent: Integer);
		340
		341	{Simple graphical crypt}
		342	procedure EncryptDecrypt(const Key: Integer);
		343
		344	{ Standalone DXFusion }
		345	{--- c o n F u s i o n ---}
		346	{By Joakim Back, www.back.mine.nu}
		347	{Huge thanks to Ilkka Tuomioja for helping out with the project.}
		348
		349	{
		350	modified by (c) 2005 Jaro Benes for DelphiX use.
		351	}
		352
		353	procedure CreateDIBFromBitmap(const Bitmap: TBitmap);
		354	{Drawing Methods.}
		355	procedure DrawOn(Dest: TRect; DestCanvas: TCanvas;
		356	Xsrc, Ysrc: Integer);
		357	procedure DrawTo(SrcDIB: TDIB; X, Y, Width, Height, SourceX,
		358	SourceY: Integer);
		359	procedure DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
		360	SourceX, SourceY: Integer; const Color: TColor); {$IFDEF VER5UP} reintroduce;{$ENDIF} //{$IFDEF VER9UP} overload;{$ENDIF}
		361	procedure DrawShadow(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
		362	FilterMode: TFilterMode);
		363	procedure DrawShadows(SrcDIB: TDIB; X, Y, Width, Height, Frame: Integer;
		364	Alpha: Byte);
		365	procedure DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
		366	Frame: Integer);
		367	procedure DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height: Integer; Alpha: Integer{$IFDEF VER4UP} = 255{$ENDIF};
		368	Frame: Integer{$IFDEF VER4UP} = 0{$ENDIF});
		369	procedure DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
		370	SourceX, SourceY: Integer; const Color: TColor;
		371	FilterMode: TFilterMode);
		372	procedure DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
		373	SourceX, SourceY: Integer; const Color: TColor);
		374	procedure DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
		375	SourceY: Integer; const Color: TColor);
		376	procedure DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
		377	SourceY, Alpha: Integer; const Color: TColor);
		378	procedure DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y, Width,
		379	Height, SourceX, SourceY: Integer);
		380	procedure DrawAntialias(SrcDIB: TDIB);
		381	procedure Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
		382	procedure DrawMono(SrcDIB: TDIB; const X, Y, Width, Height, SourceX,
		383	SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
		384	{One-color Filters.}
		385	procedure FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
		386	FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
		387	procedure FilterRect(X, Y, Width, Height: Integer; Color: TColor;
		388	FilterMode: TFilterMode); {$IFDEF VER9UP}inline;{$ENDIF}
		389	{ Lightsource. }
		390	procedure InitLight(Count, Detail: Integer);
		391	procedure DrawLights(FLight: TLightArray; AmbientLight: TColor);
		392	//
		393	// effect for special purpose
		394	//
16	daniel-mar	395	procedure FadeOut(DIB2: TDIB; Step: Byte); {$IFDEF VER9UP} inline; {$ENDIF}
4	daniel-mar	396	procedure DoZoom(DIB2: TDIB; ZoomRatio: Real);
		397	procedure DoBlur(DIB2: TDIB);
16	daniel-mar	398	procedure FadeIn(DIB2: TDIB; Step: Byte); {$IFDEF VER9UP} inline; {$ENDIF}
		399	procedure FillDIB8(Color: Byte); {$IFDEF VER9UP} inline; {$ENDIF}
4	daniel-mar	400	procedure DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
		401	procedure Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
		402	function Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
		403	// lines
		404	procedure AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor); {$IFDEF VER9UP} inline; {$ENDIF}
		405	function GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
		406	FromPoint, ToPoint: Extended): TColor;
		407	procedure ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
		408	iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry;
		409	iRadius: WORD);
		410	// standard property
1	daniel-mar	411	property BitCount: Integer read FBitCount write SetBitCount;
		412	property BitmapInfo: PBitmapInfo read GetBitmapInfo;
		413	property BitmapInfoSize: Integer read GetBitmapInfoSize;
		414	property Canvas: TCanvas read GetCanvas;
		415	property Handle: THandle read GetHandle;
		416	property Height: Integer read FHeight write SetHeight;
		417	property NextLine: Integer read FNextLine;
		418	property NowPixelFormat: TDIBPixelFormat read FNowPixelFormat write SetNowPixelFormat;
		419	property PaletteCount: Integer read GetPaletteCount;
		420	property PBits: Pointer read GetPBits;
		421	property PBitsReadOnly: Pointer read GetPBitsReadOnly;
		422	property Pixels[X, Y: Integer]: DWORD read GetPixel write SetPixel;
		423	property ScanLine[Y: Integer]: Pointer read GetScanLine;
		424	property ScanLineReadOnly[Y: Integer]: Pointer read GetScanLineReadOnly;
		425	property Size: Integer read FSize;
		426	property TopPBits: Pointer read GetTopPBits;
		427	property TopPBitsReadOnly: Pointer read GetTopPBitsReadOnly;
		428	property Width: Integer read FWidth write SetWidth;
		429	property WidthBytes: Integer read FWidthBytes;
4	daniel-mar	430	property AlphaChannel: TDIB read GetAlphaChannel write SetAlphaChannel;
		431	property RGBChannel: TDIB read GetRGBChannel write SetRGBChannel;
		432	function CreateBitmapFromDIB: TBitmap;
		433	procedure Fill(aColor: TColor);
		434	property ClientRect: TRect read GetClientRect;
1	daniel-mar	435	end;
		436
4	daniel-mar	437	{ TDIBitmap }
		438
1	daniel-mar	439	TDIBitmap = class(TDIB) end;
		440
		441	{ TCustomDXDIB }
		442
		443	TCustomDXDIB = class(TComponent)
		444	private
		445	FDIB: TDIB;
		446	procedure SetDIB(Value: TDIB);
		447	public
		448	constructor Create(AOnwer: TComponent); override;
		449	destructor Destroy; override;
		450	property DIB: TDIB read FDIB write SetDIB;
		451	end;
		452
		453	{ TDXDIB }
		454
		455	TDXDIB = class(TCustomDXDIB)
		456	published
		457	property DIB;
		458	end;
		459
		460	{ TCustomDXPaintBox }
		461
		462	TCustomDXPaintBox = class(TGraphicControl)
		463	private
		464	FAutoStretch: Boolean;
		465	FCenter: Boolean;
		466	FDIB: TDIB;
		467	FKeepAspect: Boolean;
		468	FStretch: Boolean;
		469	FViewWidth: Integer;
		470	FViewHeight: Integer;
		471	procedure SetAutoStretch(Value: Boolean);
		472	procedure SetCenter(Value: Boolean);
		473	procedure SetDIB(Value: TDIB);
		474	procedure SetKeepAspect(Value: Boolean);
		475	procedure SetStretch(Value: Boolean);
		476	procedure SetViewWidth(Value: Integer);
		477	procedure SetViewHeight(Value: Integer);
		478	protected
		479	function GetPalette: HPALETTE; override;
		480	public
		481	constructor Create(AOwner: TComponent); override;
		482	destructor Destroy; override;
		483	procedure Paint; override;
		484	property AutoStretch: Boolean read FAutoStretch write SetAutoStretch;
		485	property Canvas;
		486	property Center: Boolean read FCenter write SetCenter;
		487	property DIB: TDIB read FDIB write SetDIB;
		488	property KeepAspect: Boolean read FKeepAspect write SetKeepAspect;
		489	property Stretch: Boolean read FStretch write SetStretch;
		490	property ViewWidth: Integer read FViewWidth write SetViewWidth;
		491	property ViewHeight: Integer read FViewHeight write SetViewHeight;
		492	end;
		493
		494	{ TDXPaintBox }
		495
		496	TDXPaintBox = class(TCustomDXPaintBox)
		497	published
4	daniel-mar	498	{$IFDEF VER4UP}property Anchors; {$ENDIF}
1	daniel-mar	499	property AutoStretch;
		500	property Center;
4	daniel-mar	501	{$IFDEF VER4UP}property Constraints; {$ENDIF}
1	daniel-mar	502	property DIB;
		503	property KeepAspect;
		504	property Stretch;
		505	property ViewWidth;
		506	property ViewHeight;
		507
		508	property Align;
		509	property DragCursor;
		510	property DragMode;
		511	property Enabled;
		512	property ParentShowHint;
		513	property PopupMenu;
		514	property ShowHint;
		515	property Visible;
		516	property OnClick;
		517	property OnDblClick;
		518	property OnDragDrop;
		519	property OnDragOver;
		520	property OnEndDrag;
		521	property OnMouseDown;
		522	property OnMouseMove;
		523	property OnMouseUp;
4	daniel-mar	524	{$IFDEF VER9UP}property OnMouseWheel; {$ENDIF}
		525	{$IFDEF VER9UP}property OnResize; {$ENDIF}
		526	{$IFDEF VER9UP}property OnCanResize; {$ENDIF}
		527	{$IFDEF VER9UP}property OnContextPopup; {$ENDIF}
1	daniel-mar	528	property OnStartDrag;
		529	end;
		530
4	daniel-mar	531	const
		532	DefaultFilterRadius: array[TFilterTypeResample] of Single = (0.5, 1, 1, 1.5, 2, 3, 2);
1	daniel-mar	533
4	daniel-mar	534	function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
		535	function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat; {$IFDEF VER9UP}inline;{$ENDIF}
		536	function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD; {$IFDEF VER9UP}inline;{$ENDIF}
		537	procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
		538	function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
		539	function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
		540	function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
		541
1	daniel-mar	542	function GreyscaleColorTable: TRGBQuads;
		543
4	daniel-mar	544	function RGBQuad(R, G, B: Byte): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
		545	function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad; {$IFDEF VER9UP}inline;{$ENDIF}
		546	function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads; {$IFDEF VER9UP}inline;{$ENDIF}
		547	function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry; {$IFDEF VER9UP}inline;{$ENDIF}
		548	function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries; {$IFDEF VER9UP}inline;{$ENDIF}
1	daniel-mar	549
4	daniel-mar	550	function PosValue(Value: Integer): Integer;
		551
		552	type
		553	TOC = 0..511;
		554	function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
		555	function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
		556
		557	{ Added Constants for TFilter Type }
		558	const
		559	EdgeFilter: TFilter = ((-1, -1, -1), (-1, 8, -1), (-1, -1, -1));
		560	StrongOutlineFilter: TFilter = ((-100, 0, 0), (0, 0, 0), (0, 0, 100));
		561	Enhance3DFilter: TFilter = ((-100, 5, 5), (5, 5, 5), (5, 5, 100));
		562	LinearFilter: TFilter = ((-40, -40, -40), (-40, 255, -40), (-40, -40, -40));
		563	GranularFilter: TFilter = ((-20, 5, 20), (5, -10, 5), (100, 5, -100));
		564	SharpFilter: TFilter = ((-2, -2, -2), (-2, 20, -2), (-2, -2, -2));
		565	{ End of constants }
		566
		567	{ Added Constants for DXFusion Type }
		568	const
		569	{ 3x3 Matrix Presets. }
		570	msEmboss: TMatrixSetting = (-1, -1, 0, -1, 6, 1, 0, 1, 1, 6);
		571	msHardEmboss: TMatrixSetting = (-4, -2, -1, -2, 10, 2, -1, 2, 4, 8);
		572	msBlur: TMatrixSetting = (1, 2, 1, 2, 4, 2, 1, 2, 1, 16);
		573	msSharpen: TMatrixSetting = (-1, -1, -1, -1, 15, -1, -1, -1, -1, 7);
		574	msEdgeDetect: TMatrixSetting = (-1, -1, -1, -1, 8, -1, -1, -1, -1, 1);
		575
		576	{Proportionaly scale of size, for recountin image sizes}
		577	function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single; {$IFDEF VER9UP}inline;{$ENDIF}
		578
		579	procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP}overload; {$ENDIF}
		580	procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDIB2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP}overload; {$ENDIF}
16	daniel-mar	581	procedure MakeDIB32MaskByColor(var D: TDIB; const MaskColor: TColor{$IFDEF VER4UP} = clWhite{$ENDIF});
4	daniel-mar	582
16	daniel-mar	583	function BGR(B, G, R: Byte): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		584
1	daniel-mar	585	implementation
		586
4	daniel-mar	587	uses DXConsts, {$IFDEF PNG_GRAPHICS}pngimage,{$ENDIF} jpeg;
1	daniel-mar	588
16	daniel-mar	589	function BGR(B, G, R: Byte): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		590	begin
		591	Result := (B shl 16) or (G shl 8) or R;
		592	end;
		593
		594	procedure MakeDIB32MaskByColor(var D: TDIB; const MaskColor: TColor{$IFDEF VER4UP} = clWhite{$ENDIF});
		595	type
		596	PRGBA = ^TRGBA;
		597	TRGBA = array[0..0] of Windows.TRGBQuad;
		598	var
		599	p: PRGBA;
		600	y: Integer;
		601	x: Integer;
		602	B: TDIB;
		603	begin
		604	MakeDib(B, D.Width, D.Height, 32, $FFFFFF);
		605	B.RGBChannel := D.RGBChannel;
		606	if B.BitCount = 32 then
		607	for Y := 0 to B.Height - 1 do
		608	begin
		609	p := B.ScanLine[Y];
		610	for X := 0 to B.Width - 1 do
		611	begin
		612	if (p[X].rgbBlue = GetBValue(MaskColor)) and (p[X].rgbGreen = GetGValue(MaskColor)) and (p[X].rgbRed = GetRValue(MaskColor)) then
		613	p[X].rgbReserved := 0
		614	else
		615	p[X].rgbReserved := $FF
		616	end
		617	end;
		618	d.Assign(B);
		619	end;
		620
4	daniel-mar	621	function GetScale(SourceWidth, SourceHeight, TargetWidth, TargetHeight: Integer): Single;
		622	var
		623	XScale, YScale: Single;
		624	begin
		625	XScale := 1;
		626	YScale := 1;
		627	if TargetWidth < SourceWidth then
		628	XScale := TargetWidth / SourceWidth;
		629	if TargetHeight < SourceHeight then
		630	YScale := TargetHeight / SourceHeight;
		631	Result := XScale;
		632	if YScale < Result then
		633	Result := YScale;
		634	end;
		635
		636	{$IFNDEF VER4UP}
1	daniel-mar	637	function Max(B1, B2: Integer): Integer;
		638	begin
4	daniel-mar	639	if B1 >= B2 then Result := B1 else Result := B2;
1	daniel-mar	640	end;
		641
4	daniel-mar	642	function Min(B1, B2: Integer): Integer;
		643	begin
		644	if B1 <= B2 then Result := B1 else Result := B2;
		645	end;
		646	{$ENDIF}
		647
		648	function DSin(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
		649	begin
		650	Result := sin(((c * 360) / 511) * Pi / 180);
		651	end;
		652
		653	function DCos(const C: TOC): Single; {$IFDEF VER9UP}inline; {$ENDIF}
		654	begin
		655	Result := cos(((c * 360) / 511) * Pi / 180);
		656	end;
		657
1	daniel-mar	658	function MakeDIBPixelFormat(RBitCount, GBitCount, BBitCount: Integer): TDIBPixelFormat;
		659	begin
4	daniel-mar	660	Result.RBitMask := ((1 shl RBitCount) - 1) shl (GBitCount + BBitCount);
		661	Result.GBitMask := ((1 shl GBitCount) - 1) shl (BBitCount);
		662	Result.BBitMask := (1 shl BBitCount) - 1;
1	daniel-mar	663	Result.RBitCount := RBitCount;
		664	Result.GBitCount := GBitCount;
		665	Result.BBitCount := BBitCount;
4	daniel-mar	666	Result.RBitCount2 := 8 - RBitCount;
		667	Result.GBitCount2 := 8 - GBitCount;
		668	Result.BBitCount2 := 8 - BBitCount;
		669	Result.RShift := (GBitCount + BBitCount) - (8 - RBitCount);
		670	Result.GShift := BBitCount - (8 - GBitCount);
		671	Result.BShift := 8 - BBitCount;
1	daniel-mar	672	end;
		673
4	daniel-mar	674	function GetBitCount(b: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		675	var
		676	i: Integer;
		677	begin
		678	i := 0;
		679	while (i < 31) and (((1 shl i) and b) = 0) do Inc(i);
1	daniel-mar	680
4	daniel-mar	681	Result := 0;
		682	while ((1 shl i) and b) <> 0 do
1	daniel-mar	683	begin
4	daniel-mar	684	Inc(i);
		685	Inc(Result);
1	daniel-mar	686	end;
4	daniel-mar	687	end;
1	daniel-mar	688
4	daniel-mar	689	function MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask: Integer): TDIBPixelFormat;
1	daniel-mar	690	begin
		691	Result := MakeDIBPixelFormat(GetBitCount(RBitMask), GetBitCount(GBitMask),
		692	GetBitCount(BBitMask));
		693	end;
		694
		695	function pfRGB(const PixelFormat: TDIBPixelFormat; R, G, B: Byte): DWORD;
		696	begin
		697	with PixelFormat do
		698	Result := ((R shl RShift) and RBitMask) or ((G shl GShift) and GBitMask) or
		699	((B shr BShift) and BBitMask);
		700	end;
		701
		702	procedure pfGetRGB(const PixelFormat: TDIBPixelFormat; Color: DWORD; var R, G, B: Byte);
		703	begin
		704	with PixelFormat do
		705	begin
		706	R := (Color and RBitMask) shr RShift;
		707	R := R or (R shr RBitCount2);
		708	G := (Color and GBitMask) shr GShift;
		709	G := G or (G shr GBitCount2);
		710	B := (Color and BBitMask) shl BShift;
		711	B := B or (B shr BBitCount2);
		712	end;
		713	end;
		714
		715	function pfGetRValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
		716	begin
		717	with PixelFormat do
		718	begin
		719	Result := (Color and RBitMask) shr RShift;
4	daniel-mar	720	Result := Result or (Result shr RBitCount2);
1	daniel-mar	721	end;
		722	end;
		723
		724	function pfGetGValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
		725	begin
		726	with PixelFormat do
		727	begin
		728	Result := (Color and GBitMask) shr GShift;
4	daniel-mar	729	Result := Result or (Result shr GBitCount2);
1	daniel-mar	730	end;
		731	end;
		732
		733	function pfGetBValue(const PixelFormat: TDIBPixelFormat; Color: DWORD): Byte;
		734	begin
		735	with PixelFormat do
		736	begin
		737	Result := (Color and BBitMask) shl BShift;
4	daniel-mar	738	Result := Result or (Result shr BBitCount2);
1	daniel-mar	739	end;
		740	end;
		741
		742	function GreyscaleColorTable: TRGBQuads;
		743	var
		744	i: Integer;
		745	begin
4	daniel-mar	746	for i := 0 to 255 do
1	daniel-mar	747	with Result[i] do
		748	begin
		749	rgbRed := i;
		750	rgbGreen := i;
		751	rgbBlue := i;
		752	rgbReserved := 0;
		753	end;
		754	end;
		755
		756	function RGBQuad(R, G, B: Byte): TRGBQuad;
		757	begin
		758	with Result do
		759	begin
		760	rgbRed := R;
		761	rgbGreen := G;
		762	rgbBlue := B;
		763	rgbReserved := 0;
		764	end;
		765	end;
		766
		767	function PaletteEntryToRGBQuad(const Entry: TPaletteEntry): TRGBQuad;
		768	begin
		769	with Result do
		770	with Entry do
		771	begin
		772	rgbRed := peRed;
		773	rgbGreen := peGreen;
		774	rgbBlue := peBlue;
		775	rgbReserved := 0;
		776	end;
		777	end;
		778
		779	function PaletteEntriesToRGBQuads(const Entries: TPaletteEntries): TRGBQuads;
		780	var
		781	i: Integer;
		782	begin
4	daniel-mar	783	for i := 0 to 255 do
1	daniel-mar	784	Result[i] := PaletteEntryToRGBQuad(Entries[i]);
		785	end;
		786
		787	function RGBQuadToPaletteEntry(const RGBQuad: TRGBQuad): TPaletteEntry;
		788	begin
		789	with Result do
		790	with RGBQuad do
		791	begin
		792	peRed := rgbRed;
		793	peGreen := rgbGreen;
		794	peBlue := rgbBlue;
		795	peFlags := 0;
		796	end;
		797	end;
		798
		799	function RGBQuadsToPaletteEntries(const RGBQuads: TRGBQuads): TPaletteEntries;
		800	var
		801	i: Integer;
		802	begin
4	daniel-mar	803	for i := 0 to 255 do
1	daniel-mar	804	Result[i] := RGBQuadToPaletteEntry(RGBQuads[i]);
		805	end;
		806
		807	{ TDIBSharedImage }
		808
		809	type
		810	PLocalDIBPixelFormat = ^TLocalDIBPixelFormat;
		811	TLocalDIBPixelFormat = packed record
		812	RBitMask, GBitMask, BBitMask: DWORD;
		813	end;
		814
4	daniel-mar	815	{ TPaletteItem }
		816
1	daniel-mar	817	TPaletteItem = class(TCollectionItem)
		818	private
		819	ID: Integer;
		820	Palette: HPalette;
		821	RefCount: Integer;
		822	ColorTable: TRGBQuads;
		823	ColorTableCount: Integer;
		824	destructor Destroy; override;
		825	procedure AddRef;
4	daniel-mar	826	procedure Release; {$IFDEF VER17UP}reintroduce;{$ENDIF}
1	daniel-mar	827	end;
		828
4	daniel-mar	829	{ TPaletteManager }
		830
1	daniel-mar	831	TPaletteManager = class
		832	private
		833	FList: TCollection;
		834	constructor Create;
		835	destructor Destroy; override;
		836	function CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
		837	procedure DeletePalette(var Palette: HPalette);
		838	end;
		839
4	daniel-mar	840	{ TPaletteItem }
		841
1	daniel-mar	842	destructor TPaletteItem.Destroy;
		843	begin
		844	DeleteObject(Palette);
		845	inherited Destroy;
		846	end;
		847
		848	procedure TPaletteItem.AddRef;
		849	begin
		850	Inc(RefCount);
		851	end;
		852
		853	procedure TPaletteItem.Release;
		854	begin
		855	Dec(RefCount);
4	daniel-mar	856	if RefCount <= 0 then Free;
1	daniel-mar	857	end;
		858
4	daniel-mar	859	{ TPaletteManager }
		860
1	daniel-mar	861	constructor TPaletteManager.Create;
		862	begin
		863	inherited Create;
		864	FList := TCollection.Create(TPaletteItem);
		865	end;
		866
		867	destructor TPaletteManager.Destroy;
		868	begin
		869	FList.Free;
		870	inherited Destroy;
		871	end;
		872
		873	function TPaletteManager.CreatePalette(const ColorTable: TRGBQuads; ColorTableCount: Integer): HPalette;
		874	type
		875	TMyLogPalette = record
		876	palVersion: Word;
		877	palNumEntries: Word;
		878	palPalEntry: TPaletteEntries;
		879	end;
		880	var
		881	i, ID: Integer;
		882	Item: TPaletteItem;
		883	LogPalette: TMyLogPalette;
		884	begin
		885	{ Hash key making }
		886	ID := ColorTableCount;
4	daniel-mar	887	for i := 0 to ColorTableCount - 1 do
1	daniel-mar	888	with ColorTable[i] do
		889	begin
		890	Inc(ID, rgbRed);
		891	Inc(ID, rgbGreen);
		892	Inc(ID, rgbBlue);
		893	end;
		894
		895	{ Does the same palette already exist? }
4	daniel-mar	896	for i := 0 to FList.Count - 1 do
1	daniel-mar	897	begin
		898	Item := TPaletteItem(FList.Items[i]);
4	daniel-mar	899	if (Item.ID = ID) and (Item.ColorTableCount = ColorTableCount) and
		900	CompareMem(@Item.ColorTable, @ColorTable, ColorTableCount * SizeOf(TRGBQuad)) then
1	daniel-mar	901	begin
		902	Item.AddRef; Result := Item.Palette;
		903	Exit;
		904	end;
		905	end;
		906
		907	{ New palette making }
		908	Item := TPaletteItem.Create(FList);
		909	Item.ID := ID;
4	daniel-mar	910	Move(ColorTable, Item.ColorTable, ColorTableCount * SizeOf(TRGBQuad));
1	daniel-mar	911	Item.ColorTableCount := ColorTableCount;
		912
		913	with LogPalette do
		914	begin
		915	palVersion := $300;
		916	palNumEntries := ColorTableCount;
		917	palPalEntry := RGBQuadsToPaletteEntries(ColorTable);
		918	end;
		919
		920	Item.Palette := Windows.CreatePalette(PLogPalette(@LogPalette)^);
		921	Item.AddRef; Result := Item.Palette;
		922	end;
		923
		924	procedure TPaletteManager.DeletePalette(var Palette: HPalette);
		925	var
		926	i: Integer;
		927	Item: TPaletteItem;
		928	begin
4	daniel-mar	929	if Palette = 0 then Exit;
1	daniel-mar	930
4	daniel-mar	931	for i := 0 to FList.Count - 1 do
1	daniel-mar	932	begin
		933	Item := TPaletteItem(FList.Items[i]);
4	daniel-mar	934	if (Item.Palette = Palette) then
1	daniel-mar	935	begin
		936	Palette := 0;
		937	Item.Release;
		938	Exit;
		939	end;
		940	end;
		941	end;
		942
		943	var
		944	FPaletteManager: TPaletteManager;
		945
		946	function PaletteManager: TPaletteManager;
		947	begin
4	daniel-mar	948	if FPaletteManager = nil then
1	daniel-mar	949	FPaletteManager := TPaletteManager.Create;
		950	Result := FPaletteManager;
		951	end;
		952
4	daniel-mar	953	{ TDIBSharedImage }
		954
1	daniel-mar	955	constructor TDIBSharedImage.Create;
		956	begin
		957	inherited Create;
		958	FMemoryImage := True;
		959	SetColorTable(GreyscaleColorTable);
		960	FColorTable := GreyscaleColorTable;
		961	FPixelFormat := MakeDIBPixelFormat(8, 8, 8);
		962	end;
		963
		964	procedure TDIBSharedImage.NewImage(AWidth, AHeight, ABitCount: Integer;
		965	const PixelFormat: TDIBPixelFormat; const ColorTable: TRGBQuads; MemoryImage, Compressed: Boolean);
		966	var
		967	InfoOfs: Integer;
		968	UsePixelFormat: Boolean;
		969	begin
4	daniel-mar	970	{$IFNDEF D17UP}
		971	{self recreation is not allowed here}
1	daniel-mar	972	Create;
4	daniel-mar	973	{$ENDIF}
1	daniel-mar	974	{ Pixel format check }
		975	case ABitCount of
4	daniel-mar	976	1: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
		977	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		978	4: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
		979	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		980	8: if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
		981	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		982	16:
		983	begin
		984	if not (((PixelFormat.RBitMask = $7C00) and (PixelFormat.GBitMask = $03E0) and (PixelFormat.BBitMask = $001F)) or
		985	((PixelFormat.RBitMask = $F800) and (PixelFormat.GBitMask = $07E0) and (PixelFormat.BBitMask = $001F))) then
		986	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		987	end;
		988	24:
		989	begin
		990	if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
		991	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		992	end;
		993	32:
		994	begin
		995	if not ((PixelFormat.RBitMask = $FF0000) and (PixelFormat.GBitMask = $00FF00) and (PixelFormat.BBitMask = $0000FF)) then
		996	raise EInvalidGraphicOperation.Create(SInvalidDIBPixelFormat);
		997	end;
1	daniel-mar	998	else
		999	raise EInvalidGraphicOperation.CreateFmt(SInvalidDIBBitCount, [ABitCount]);
		1000	end;
		1001
		1002	FBitCount := ABitCount;
		1003	FHeight := AHeight;
		1004	FWidth := AWidth;
4	daniel-mar	1005	FWidthBytes := (((AWidth * ABitCount) + 31) shr 5) * 4;
1	daniel-mar	1006	FNextLine := -FWidthBytes;
4	daniel-mar	1007	FSize := FWidthBytes * FHeight;
1	daniel-mar	1008	UsePixelFormat := ABitCount in [16, 32];
		1009
		1010	FPixelFormat := PixelFormat;
		1011
		1012	FPaletteCount := 0;
4	daniel-mar	1013	if FBitCount <= 8 then
1	daniel-mar	1014	FPaletteCount := 1 shl FBitCount;
		1015
		1016	FBitmapInfoSize := SizeOf(TBitmapInfoHeader);
		1017	if UsePixelFormat then
		1018	Inc(FBitmapInfoSize, SizeOf(TLocalDIBPixelFormat));
4	daniel-mar	1019	Inc(FBitmapInfoSize, SizeOf(TRGBQuad) * FPaletteCount);
1	daniel-mar	1020
		1021	GetMem(FBitmapInfo, FBitmapInfoSize);
		1022	FillChar(FBitmapInfo^, FBitmapInfoSize, 0);
		1023
		1024	{ BitmapInfo setting. }
		1025	with FBitmapInfo^.bmiHeader do
		1026	begin
		1027	biSize := SizeOf(TBitmapInfoHeader);
		1028	biWidth := FWidth;
		1029	biHeight := FHeight;
		1030	biPlanes := 1;
		1031	biBitCount := FBitCount;
		1032	if UsePixelFormat then
		1033	biCompression := BI_BITFIELDS
		1034	else
		1035	begin
16	daniel-mar	1036	biCompression := 0; //none
4	daniel-mar	1037	if (FBitCount = 4) and (Compressed) then
1	daniel-mar	1038	biCompression := BI_RLE4
4	daniel-mar	1039	else if (FBitCount = 8) and (Compressed) then
1	daniel-mar	1040	biCompression := BI_RLE8
		1041	else
16	daniel-mar	1042	if FBitCount = 24 then
		1043	biCompression := BI_RGB;
1	daniel-mar	1044	end;
		1045	biSizeImage := FSize;
		1046	biXPelsPerMeter := 0;
		1047	biYPelsPerMeter := 0;
		1048	biClrUsed := 0;
		1049	biClrImportant := 0;
		1050	end;
		1051	InfoOfs := SizeOf(TBitmapInfoHeader);
		1052
		1053	if UsePixelFormat then
		1054	begin
4	daniel-mar	1055	with PLocalDIBPixelFormat(Integer(FBitmapInfo) + InfoOfs)^ do
1	daniel-mar	1056	begin
		1057	RBitMask := PixelFormat.RBitMask;
		1058	GBitMask := PixelFormat.GBitMask;
		1059	BBitMask := PixelFormat.BBitMask;
		1060	end;
		1061
		1062	Inc(InfoOfs, SizeOf(TLocalDIBPixelFormat));
		1063	end;
		1064
		1065	FColorTablePos := InfoOfs;
		1066
		1067	FColorTable := ColorTable;
4	daniel-mar	1068	Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount);
1	daniel-mar	1069
		1070	FCompressed := FBitmapInfo^.bmiHeader.biCompression in [BI_RLE4, BI_RLE8];
		1071	FMemoryImage := MemoryImage or FCompressed;
		1072
		1073	{ DIB making. }
		1074	if not Compressed then
		1075	begin
		1076	if MemoryImage then
		1077	begin
		1078	FPBits := Pointer(GlobalAlloc(GMEM_FIXED, FSize));
4	daniel-mar	1079	if FPBits = nil then
1	daniel-mar	1080	OutOfMemoryError;
4	daniel-mar	1081	end
		1082	else
1	daniel-mar	1083	begin
		1084	FDC := CreateCompatibleDC(0);
		1085
		1086	FHandle := CreateDIBSection(FDC, FBitmapInfo^, DIB_RGB_COLORS, FPBits, 0, 0);
4	daniel-mar	1087	if FHandle = 0 then
1	daniel-mar	1088	raise EOutOfResources.CreateFmt(SCannotMade, ['DIB']);
		1089
		1090	FOldHandle := SelectObject(FDC, FHandle);
		1091	end;
		1092	end;
		1093
4	daniel-mar	1094	FTopPBits := Pointer(Integer(FPBits) + (FHeight - 1) * FWidthBytes);
1	daniel-mar	1095	end;
		1096
		1097	procedure TDIBSharedImage.Duplicate(Source: TDIBSharedImage; MemoryImage: Boolean);
		1098	begin
4	daniel-mar	1099	if Source = nil then Exit; //no source
		1100
		1101	if Source.FSize = 0 then
1	daniel-mar	1102	begin
4	daniel-mar	1103	{$IFNDEF D17UP}
		1104	{self recreation is not allowed here}
1	daniel-mar	1105	Create;
4	daniel-mar	1106	{$ENDIF}
1	daniel-mar	1107	FMemoryImage := MemoryImage;
4	daniel-mar	1108	end
		1109	else
1	daniel-mar	1110	begin
		1111	NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
		1112	Source.FPixelFormat, Source.FColorTable, MemoryImage, Source.FCompressed);
		1113	if FCompressed then
		1114	begin
		1115	FBitmapInfo.bmiHeader.biSizeImage := Source.FBitmapInfo.bmiHeader.biSizeImage;
		1116	GetMem(FPBits, FBitmapInfo.bmiHeader.biSizeImage);
		1117	Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
4	daniel-mar	1118	end
		1119	else
1	daniel-mar	1120	begin
		1121	Move(Source.FPBits^, FPBits^, FBitmapInfo.bmiHeader.biSizeImage);
		1122	end;
		1123	end;
		1124	end;
		1125
		1126	procedure TDIBSharedImage.Compress(Source: TDIBSharedImage);
		1127
		1128	procedure EncodeRLE4;
		1129	var
		1130	Size: Integer;
		1131
		1132	function AllocByte: PByte;
		1133	begin
4	daniel-mar	1134	if Size mod 4096 = 0 then
		1135	ReAllocMem(FPBits, Size + 4095);
		1136	Result := Pointer(Integer(FPBits) + Size);
1	daniel-mar	1137	Inc(Size);
		1138	end;
		1139
		1140	var
		1141	B1, B2, C: Byte;
		1142	PB1, PB2: Integer;
		1143	Src: PByte;
		1144	X, Y: Integer;
		1145
		1146	function GetPixel(x: Integer): Integer;
		1147	begin
4	daniel-mar	1148	if X and 1 = 0 then
1	daniel-mar	1149	Result := PArrayByte(Src)[X shr 1] shr 4
		1150	else
		1151	Result := PArrayByte(Src)[X shr 1] and $0F;
		1152	end;
		1153
		1154	begin
		1155	Size := 0;
		1156
4	daniel-mar	1157	for y := 0 to Source.FHeight - 1 do
1	daniel-mar	1158	begin
		1159	x := 0;
4	daniel-mar	1160	Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes);
		1161	while x < Source.FWidth do
1	daniel-mar	1162	begin
4	daniel-mar	1163	if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) then
1	daniel-mar	1164	begin
		1165	{ Encoding mode }
		1166	B1 := 2;
4	daniel-mar	1167	B2 := (GetPixel(x) shl 4) or GetPixel(x + 1);
1	daniel-mar	1168
		1169	Inc(x, 2);
		1170
		1171	C := B2;
		1172
4	daniel-mar	1173	while (x < Source.FWidth) and (C and $F = GetPixel(x)) and (B1 < 255) do
1	daniel-mar	1174	begin
		1175	Inc(B1);
		1176	Inc(x);
		1177	C := (C shr 4) or (C shl 4);
		1178	end;
		1179
		1180	AllocByte^ := B1;
		1181	AllocByte^ := B2;
4	daniel-mar	1182	end
		1183	else
		1184	if (Source.FWidth - x > 5) and ((GetPixel(x) <> GetPixel(x + 2)) or (GetPixel(x + 1) <> GetPixel(x + 3))) and
		1185	((GetPixel(x + 2) = GetPixel(x + 4)) and (GetPixel(x + 3) = GetPixel(x + 5))) then
		1186	begin
1	daniel-mar	1187	{ Encoding mode }
4	daniel-mar	1188	AllocByte^ := 2;
		1189	AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
		1190	Inc(x, 2);
		1191	end
		1192	else
1	daniel-mar	1193	begin
4	daniel-mar	1194	if (Source.FWidth - x < 4) then
		1195	begin
1	daniel-mar	1196	{ Encoding mode }
4	daniel-mar	1197	while Source.FWidth - x >= 2 do
		1198	begin
		1199	AllocByte^ := 2;
		1200	AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
		1201	Inc(x, 2);
		1202	end;
1	daniel-mar	1203
4	daniel-mar	1204	if Source.FWidth - x = 1 then
		1205	begin
		1206	AllocByte^ := 1;
		1207	AllocByte^ := GetPixel(x) shl 4;
		1208	Inc(x);
		1209	end;
		1210	end
		1211	else
1	daniel-mar	1212	begin
		1213	{ Absolute mode }
4	daniel-mar	1214	PB1 := Size; AllocByte;
		1215	PB2 := Size; AllocByte;
1	daniel-mar	1216
4	daniel-mar	1217	B1 := 0;
		1218	B2 := 4;
1	daniel-mar	1219
4	daniel-mar	1220	AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
		1221	AllocByte^ := (GetPixel(x + 2) shl 4) or GetPixel(x + 3);
1	daniel-mar	1222
4	daniel-mar	1223	Inc(x, 4);
1	daniel-mar	1224
4	daniel-mar	1225	while (x + 1 < Source.FWidth) and (B2 < 254) do
		1226	begin
		1227	if (Source.FWidth - x > 3) and (GetPixel(x) = GetPixel(x + 2)) and (GetPixel(x + 1) = GetPixel(x + 3)) then
		1228	Break;
1	daniel-mar	1229
4	daniel-mar	1230	AllocByte^ := (GetPixel(x) shl 4) or GetPixel(x + 1);
		1231	Inc(B2, 2);
		1232	Inc(x, 2);
		1233	end;
		1234
		1235	PByte(Integer(FPBits) + PB1)^ := B1;
		1236	PByte(Integer(FPBits) + PB2)^ := B2;
1	daniel-mar	1237	end;
		1238	end;
		1239
4	daniel-mar	1240	if Size and 1 = 1 then AllocByte;
1	daniel-mar	1241	end;
		1242
		1243	{ End of line }
		1244	AllocByte^ := 0;
		1245	AllocByte^ := 0;
		1246	end;
		1247
		1248	{ End of bitmap }
		1249	AllocByte^ := 0;
		1250	AllocByte^ := 1;
		1251
		1252	FBitmapInfo.bmiHeader.biSizeImage := Size;
		1253	FSize := Size;
		1254	end;
		1255
		1256	procedure EncodeRLE8;
		1257	var
		1258	Size: Integer;
		1259
		1260	function AllocByte: PByte;
		1261	begin
4	daniel-mar	1262	if Size mod 4096 = 0 then
		1263	ReAllocMem(FPBits, Size + 4095);
		1264	Result := Pointer(Integer(FPBits) + Size);
1	daniel-mar	1265	Inc(Size);
		1266	end;
		1267
		1268	var
		1269	B1, B2: Byte;
		1270	PB1, PB2: Integer;
		1271	Src: PByte;
		1272	X, Y: Integer;
		1273	begin
		1274	Size := 0;
		1275
4	daniel-mar	1276	for y := 0 to Source.FHeight - 1 do
1	daniel-mar	1277	begin
		1278	x := 0;
4	daniel-mar	1279	Src := Pointer(Integer(Source.FPBits) + y * FWidthBytes);
		1280	while x < Source.FWidth do
1	daniel-mar	1281	begin
4	daniel-mar	1282	if (Source.FWidth - x > 2) and (Src^ = PByte(Integer(Src) + 1)^) then
1	daniel-mar	1283	begin
		1284	{ Encoding mode }
		1285	B1 := 2;
		1286	B2 := Src^;
		1287
		1288	Inc(x, 2);
		1289	Inc(Src, 2);
		1290
4	daniel-mar	1291	while (x < Source.FWidth) and (Src^ = B2) and (B1 < 255) do
1	daniel-mar	1292	begin
		1293	Inc(B1);
		1294	Inc(x);
		1295	Inc(Src);
		1296	end;
		1297
		1298	AllocByte^ := B1;
		1299	AllocByte^ := B2;
4	daniel-mar	1300	end
		1301	else
		1302	if (Source.FWidth - x > 2) and (Src^ <> PByte(Integer(Src) + 1)^) and (PByte(Integer(Src) + 1)^ = PByte(Integer(Src) + 2)^) then
		1303	begin
1	daniel-mar	1304	{ Encoding mode }
4	daniel-mar	1305	AllocByte^ := 1;
		1306	AllocByte^ := Src^; Inc(Src);
		1307	Inc(x);
		1308	end
		1309	else
1	daniel-mar	1310	begin
4	daniel-mar	1311	if (Source.FWidth - x < 4) then
		1312	begin
1	daniel-mar	1313	{ Encoding mode }
4	daniel-mar	1314	if Source.FWidth - x = 2 then
		1315	begin
		1316	AllocByte^ := 1;
		1317	AllocByte^ := Src^; Inc(Src);
1	daniel-mar	1318
4	daniel-mar	1319	AllocByte^ := 1;
		1320	AllocByte^ := Src^; Inc(Src);
		1321	Inc(x, 2);
		1322	end
		1323	else
		1324	begin
		1325	AllocByte^ := 1;
		1326	AllocByte^ := Src^; Inc(Src);
		1327	Inc(x);
		1328	end;
		1329	end
		1330	else
1	daniel-mar	1331	begin
		1332	{ Absolute mode }
4	daniel-mar	1333	PB1 := Size; AllocByte;
		1334	PB2 := Size; AllocByte;
1	daniel-mar	1335
4	daniel-mar	1336	B1 := 0;
		1337	B2 := 3;
1	daniel-mar	1338
4	daniel-mar	1339	Inc(x, 3);
1	daniel-mar	1340
4	daniel-mar	1341	AllocByte^ := Src^; Inc(Src);
		1342	AllocByte^ := Src^; Inc(Src);
		1343	AllocByte^ := Src^; Inc(Src);
1	daniel-mar	1344
4	daniel-mar	1345	while (x < Source.FWidth) and (B2 < 255) do
		1346	begin
		1347	if (Source.FWidth - x > 3) and (Src^ = PByte(Integer(Src) + 1)^) and (Src^ = PByte(Integer(Src) + 2)^) and (Src^ = PByte(Integer(Src) + 3)^) then
		1348	Break;
1	daniel-mar	1349
4	daniel-mar	1350	AllocByte^ := Src^; Inc(Src);
		1351	Inc(B2);
		1352	Inc(x);
		1353	end;
		1354
		1355	PByte(Integer(FPBits) + PB1)^ := B1;
		1356	PByte(Integer(FPBits) + PB2)^ := B2;
1	daniel-mar	1357	end;
		1358	end;
		1359
4	daniel-mar	1360	if Size and 1 = 1 then AllocByte;
1	daniel-mar	1361	end;
		1362
		1363	{ End of line }
		1364	AllocByte^ := 0;
		1365	AllocByte^ := 0;
		1366	end;
		1367
		1368	{ End of bitmap }
		1369	AllocByte^ := 0;
		1370	AllocByte^ := 1;
		1371
		1372	FBitmapInfo.bmiHeader.biSizeImage := Size;
		1373	FSize := Size;
		1374	end;
		1375
		1376	begin
		1377	if Source.FCompressed then
		1378	Duplicate(Source, Source.FMemoryImage)
4	daniel-mar	1379	else
		1380	begin
1	daniel-mar	1381	NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
		1382	Source.FPixelFormat, Source.FColorTable, True, True);
		1383	case FBitmapInfo.bmiHeader.biCompression of
		1384	BI_RLE4: EncodeRLE4;
		1385	BI_RLE8: EncodeRLE8;
		1386	else
		1387	Duplicate(Source, Source.FMemoryImage);
		1388	end;
		1389	end;
		1390	end;
		1391
		1392	procedure TDIBSharedImage.Decompress(Source: TDIBSharedImage; MemoryImage: Boolean);
		1393
		1394	procedure DecodeRLE4;
		1395	var
		1396	B1, B2, C: Byte;
		1397	Dest, Src, P: PByte;
		1398	X, Y, i: Integer;
		1399	begin
		1400	Src := Source.FPBits;
		1401	X := 0;
		1402	Y := 0;
		1403
		1404	while True do
		1405	begin
		1406	B1 := Src^; Inc(Src);
		1407	B2 := Src^; Inc(Src);
		1408
4	daniel-mar	1409	if B1 = 0 then
1	daniel-mar	1410	begin
		1411	case B2 of
4	daniel-mar	1412	0: begin { End of line }
		1413	X := 0;
		1414	Inc(Y);
		1415	end;
1	daniel-mar	1416	1: Break; { End of bitmap }
4	daniel-mar	1417	2: begin { Difference of coordinates }
		1418	Inc(X, B1);
		1419	Inc(Y, B2); Inc(Src, 2);
		1420	end;
1	daniel-mar	1421	else
		1422	{ Absolute mode }
4	daniel-mar	1423	Dest := Pointer(Longint(FPBits) + Y * FWidthBytes);
1	daniel-mar	1424
		1425	C := 0;
4	daniel-mar	1426	for i := 0 to B2 - 1 do
1	daniel-mar	1427	begin
4	daniel-mar	1428	if i and 1 = 0 then
1	daniel-mar	1429	begin
		1430	C := Src^; Inc(Src);
4	daniel-mar	1431	end
		1432	else
1	daniel-mar	1433	begin
		1434	C := C shl 4;
		1435	end;
		1436
4	daniel-mar	1437	P := Pointer(Integer(Dest) + X shr 1);
		1438	if X and 1 = 0 then
1	daniel-mar	1439	P^ := (P^ and $0F) or (C and $F0)
		1440	else
		1441	P^ := (P^ and $F0) or ((C and $F0) shr 4);
		1442
		1443	Inc(X);
		1444	end;
		1445	end;
4	daniel-mar	1446	end
		1447	else
1	daniel-mar	1448	begin
		1449	{ Encoding mode }
4	daniel-mar	1450	Dest := Pointer(Longint(FPBits) + Y * FWidthBytes);
1	daniel-mar	1451
4	daniel-mar	1452	for i := 0 to B1 - 1 do
1	daniel-mar	1453	begin
4	daniel-mar	1454	P := Pointer(Integer(Dest) + X shr 1);
		1455	if X and 1 = 0 then
1	daniel-mar	1456	P^ := (P^ and $0F) or (B2 and $F0)
		1457	else
		1458	P^ := (P^ and $F0) or ((B2 and $F0) shr 4);
		1459
		1460	Inc(X);
		1461
		1462	// Swap nibble
		1463	B2 := (B2 shr 4) or (B2 shl 4);
		1464	end;
		1465	end;
		1466
		1467	{ Word arrangement }
		1468	Inc(Src, Longint(Src) and 1);
		1469	end;
		1470	end;
		1471
		1472	procedure DecodeRLE8;
		1473	var
		1474	B1, B2: Byte;
		1475	Dest, Src: PByte;
		1476	X, Y: Integer;
		1477	begin
		1478	Dest := FPBits;
		1479	Src := Source.FPBits;
		1480	X := 0;
		1481	Y := 0;
		1482
		1483	while True do
		1484	begin
		1485	B1 := Src^; Inc(Src);
		1486	B2 := Src^; Inc(Src);
		1487
4	daniel-mar	1488	if B1 = 0 then
1	daniel-mar	1489	begin
		1490	case B2 of
4	daniel-mar	1491	0: begin { End of line }
		1492	X := 0; Inc(Y);
		1493	Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X);
		1494	end;
1	daniel-mar	1495	1: Break; { End of bitmap }
4	daniel-mar	1496	2: begin { Difference of coordinates }
		1497	Inc(X, B1); Inc(Y, B2); Inc(Src, 2);
		1498	Dest := Pointer(Longint(FPBits) + Y * FWidthBytes + X);
		1499	end;
1	daniel-mar	1500	else
		1501	{ Absolute mode }
		1502	Move(Src^, Dest^, B2); Inc(Dest, B2); Inc(Src, B2);
		1503	end;
4	daniel-mar	1504	end
		1505	else
1	daniel-mar	1506	begin
		1507	{ Encoding mode }
		1508	FillChar(Dest^, B1, B2); Inc(Dest, B1);
		1509	end;
		1510
		1511	{ Word arrangement }
		1512	Inc(Src, Longint(Src) and 1);
		1513	end;
		1514	end;
		1515
		1516	begin
		1517	if not Source.FCompressed then
		1518	Duplicate(Source, MemoryImage)
4	daniel-mar	1519	else
		1520	begin
1	daniel-mar	1521	NewImage(Source.FWidth, Source.FHeight, Source.FBitCount,
		1522	Source.FPixelFormat, Source.FColorTable, MemoryImage, False);
		1523	case Source.FBitmapInfo.bmiHeader.biCompression of
		1524	BI_RLE4: DecodeRLE4;
		1525	BI_RLE8: DecodeRLE8;
		1526	else
		1527	Duplicate(Source, MemoryImage);
4	daniel-mar	1528	end;
1	daniel-mar	1529	end;
		1530	end;
		1531
		1532	procedure TDIBSharedImage.ReadData(Stream: TStream; MemoryImage: Boolean);
		1533	var
		1534	BI: TBitmapInfoHeader;
		1535	BC: TBitmapCoreHeader;
		1536	BCRGB: array[0..255] of TRGBTriple;
		1537
		1538	procedure LoadRLE4;
		1539	begin
		1540	FSize := BI.biSizeImage;
4	daniel-mar	1541	//GetMem(FPBits, FSize);
1	daniel-mar	1542	FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
		1543	FBitmapInfo.bmiHeader.biSizeImage := FSize;
		1544	Stream.ReadBuffer(FPBits^, FSize);
		1545	end;
		1546
		1547	procedure LoadRLE8;
		1548	begin
		1549	FSize := BI.biSizeImage;
4	daniel-mar	1550	//GetMem(FPBits, FSize);
1	daniel-mar	1551	FPBits := GlobalAllocPtr(GMEM_FIXED, FSize);
		1552	FBitmapInfo.bmiHeader.biSizeImage := FSize;
		1553	Stream.ReadBuffer(FPBits^, FSize);
		1554	end;
		1555
		1556	procedure LoadRGB;
		1557	var
		1558	y: Integer;
		1559	begin
4	daniel-mar	1560	if BI.biHeight < 0 then
1	daniel-mar	1561	begin
4	daniel-mar	1562	for y := 0 to Abs(BI.biHeight) - 1 do
		1563	Stream.ReadBuffer(Pointer(Integer(FTopPBits) + y * FNextLine)^, FWidthBytes);
		1564	end
		1565	else
1	daniel-mar	1566	begin
		1567	Stream.ReadBuffer(FPBits^, FSize);
		1568	end;
		1569	end;
		1570
		1571	var
		1572	i, PalCount: Integer;
		1573	OS2: Boolean;
		1574	Localpf: TLocalDIBPixelFormat;
		1575	AColorTable: TRGBQuads;
		1576	APixelFormat: TDIBPixelFormat;
		1577	begin
4	daniel-mar	1578	if not Assigned(Stream) then Exit;
		1579
1	daniel-mar	1580	{ Header size reading }
		1581	i := Stream.Read(BI.biSize, 4);
		1582
4	daniel-mar	1583	if i = 0 then
1	daniel-mar	1584	begin
4	daniel-mar	1585	{$IFNDEF D17UP}
		1586	{self recreation is not allowed here}
1	daniel-mar	1587	Create;
4	daniel-mar	1588	{$ENDIF}
1	daniel-mar	1589	Exit;
		1590	end;
4	daniel-mar	1591	if i <> 4 then
1	daniel-mar	1592	raise EInvalidGraphic.Create(SInvalidDIB);
		1593
		1594	{ Kind check of DIB }
		1595	OS2 := False;
		1596
		1597	case BI.biSize of
		1598	SizeOf(TBitmapCoreHeader):
		1599	begin
		1600	{ OS/2 type }
4	daniel-mar	1601	Stream.ReadBuffer(Pointer(Integer(@BC) + 4)^, SizeOf(TBitmapCoreHeader) - 4);
1	daniel-mar	1602
		1603	with BI do
		1604	begin
		1605	biClrUsed := 0;
		1606	biCompression := BI_RGB;
		1607	biBitCount := BC.bcBitCount;
		1608	biHeight := BC.bcHeight;
		1609	biWidth := BC.bcWidth;
		1610	end;
		1611
		1612	OS2 := True;
		1613	end;
		1614	SizeOf(TBitmapInfoHeader):
		1615	begin
		1616	{ Windows type }
4	daniel-mar	1617	Stream.ReadBuffer(Pointer(Integer(@BI) + 4)^, SizeOf(TBitmapInfoHeader) - 4);
1	daniel-mar	1618	end;
		1619	else
		1620	raise EInvalidGraphic.Create(SInvalidDIB);
		1621	end;
		1622
		1623	{ Bit mask reading. }
		1624	if BI.biCompression = BI_BITFIELDS then
		1625	begin
		1626	Stream.ReadBuffer(Localpf, SizeOf(Localpf));
		1627	with Localpf do
		1628	APixelFormat := MakeDIBPixelFormatMask(RBitMask, GBitMask, BBitMask);
4	daniel-mar	1629	end
		1630	else
1	daniel-mar	1631	begin
4	daniel-mar	1632	if BI.biBitCount = 16 then
1	daniel-mar	1633	APixelFormat := MakeDIBPixelFormat(5, 5, 5)
4	daniel-mar	1634	else if BI.biBitCount = 32 then
1	daniel-mar	1635	APixelFormat := MakeDIBPixelFormat(8, 8, 8)
		1636	else
		1637	APixelFormat := MakeDIBPixelFormat(8, 8, 8);
		1638	end;
		1639
		1640	{ Palette reading }
		1641	PalCount := BI.biClrUsed;
4	daniel-mar	1642	if (PalCount = 0) and (BI.biBitCount <= 8) then
1	daniel-mar	1643	PalCount := 1 shl BI.biBitCount;
4	daniel-mar	1644	if PalCount > 256 then PalCount := 256;
1	daniel-mar	1645
		1646	FillChar(AColorTable, SizeOf(AColorTable), 0);
		1647
		1648	if OS2 then
		1649	begin
		1650	{ OS/2 type }
4	daniel-mar	1651	Stream.ReadBuffer(BCRGB, SizeOf(TRGBTriple) * PalCount);
		1652	for i := 0 to PalCount - 1 do
1	daniel-mar	1653	begin
		1654	with BCRGB[i] do
		1655	AColorTable[i] := RGBQuad(rgbtRed, rgbtGreen, rgbtBlue);
		1656	end;
4	daniel-mar	1657	end
		1658	else
1	daniel-mar	1659	begin
		1660	{ Windows type }
4	daniel-mar	1661	Stream.ReadBuffer(AColorTable, SizeOf(TRGBQuad) * PalCount);
1	daniel-mar	1662	end;
		1663
4	daniel-mar	1664	{ DIB compilation }
1	daniel-mar	1665	NewImage(BI.biWidth, Abs(BI.biHeight), BI.biBitCount, APixelFormat, AColorTable,
		1666	MemoryImage, BI.biCompression in [BI_RLE4, BI_RLE8]);
		1667
		1668	{ Pixel data reading }
		1669	case BI.biCompression of
4	daniel-mar	1670	BI_RGB: LoadRGB;
		1671	BI_RLE4: LoadRLE4;
		1672	BI_RLE8: LoadRLE8;
1	daniel-mar	1673	BI_BITFIELDS: LoadRGB;
		1674	else
		1675	raise EInvalidGraphic.Create(SInvalidDIB);
		1676	end;
		1677	end;
		1678
		1679	destructor TDIBSharedImage.Destroy;
		1680	begin
4	daniel-mar	1681	if FHandle <> 0 then
1	daniel-mar	1682	begin
4	daniel-mar	1683	if FOldHandle <> 0 then SelectObject(FDC, FOldHandle);
1	daniel-mar	1684	DeleteObject(FHandle);
4	daniel-mar	1685	end
		1686	else
		1687	// GlobalFree(THandle(FPBits));
1	daniel-mar	1688	begin
4	daniel-mar	1689	if FPBits <> nil then
1	daniel-mar	1690	GlobalFreePtr(FPBits);
		1691	end;
		1692
		1693	PaletteManager.DeletePalette(FPalette);
4	daniel-mar	1694	if FDC <> 0 then DeleteDC(FDC);
1	daniel-mar	1695
		1696	FreeMem(FBitmapInfo);
		1697	inherited Destroy;
		1698	end;
		1699
		1700	procedure TDIBSharedImage.FreeHandle;
		1701	begin
		1702	end;
		1703
		1704	function TDIBSharedImage.GetPalette: THandle;
		1705	begin
4	daniel-mar	1706	if FPaletteCount > 0 then
1	daniel-mar	1707	begin
		1708	if FChangePalette then
		1709	begin
		1710	FChangePalette := False;
		1711	PaletteManager.DeletePalette(FPalette);
		1712	FPalette := PaletteManager.CreatePalette(FColorTable, FPaletteCount);
		1713	end;
		1714	Result := FPalette;
		1715	end else
		1716	Result := 0;
		1717	end;
		1718
		1719	procedure TDIBSharedImage.SetColorTable(const Value: TRGBQuads);
		1720	begin
		1721	FColorTable := Value;
		1722	FChangePalette := True;
		1723
4	daniel-mar	1724	if (FSize > 0) and (FPaletteCount > 0) then
1	daniel-mar	1725	begin
		1726	SetDIBColorTable(FDC, 0, 256, FColorTable);
4	daniel-mar	1727	Move(FColorTable, Pointer(Integer(FBitmapInfo) + FColorTablePos)^, SizeOf(TRGBQuad) * FPaletteCount);
1	daniel-mar	1728	end;
		1729	end;
		1730
		1731	{ TDIB }
		1732
		1733	var
		1734	FEmptyDIBImage: TDIBSharedImage;
		1735
		1736	function EmptyDIBImage: TDIBSharedImage;
		1737	begin
4	daniel-mar	1738	if FEmptyDIBImage = nil then
1	daniel-mar	1739	begin
		1740	FEmptyDIBImage := TDIBSharedImage.Create;
		1741	FEmptyDIBImage.Reference;
		1742	end;
		1743	Result := FEmptyDIBImage;
		1744	end;
		1745
		1746	constructor TDIB.Create;
		1747	begin
		1748	inherited Create;
		1749	SetImage(EmptyDIBImage);
4	daniel-mar	1750
		1751	FFreeList := TList.Create;
1	daniel-mar	1752	end;
		1753
		1754	destructor TDIB.Destroy;
4	daniel-mar	1755	var
		1756	D: TDIB;
1	daniel-mar	1757	begin
		1758	SetImage(EmptyDIBImage);
		1759	FCanvas.Free;
4	daniel-mar	1760
		1761	while FFreeList.Count > 0 do
		1762	try
		1763	D := TDIB(FFreeList[0]);
		1764	FFreeList.Remove(D);
16	daniel-mar	1765	if (D <> nil) and (D.Height > 0) and (D.Width > 0) then //is really pointed to image?
		1766	D.Free;
4	daniel-mar	1767	except
16	daniel-mar	1768	// it is silent exception, but it can through outer (abstract) exception
4	daniel-mar	1769	end;
		1770	FFreeList.Free;
		1771
1	daniel-mar	1772	inherited Destroy;
		1773	end;
		1774
		1775	procedure TDIB.Assign(Source: TPersistent);
		1776
		1777	procedure AssignBitmap(Source: TBitmap);
		1778	var
		1779	Data: array[0..1023] of Byte;
		1780	BitmapRec: Windows.PBitmap;
		1781	DIBSectionRec: PDIBSection;
		1782	PaletteEntries: TPaletteEntries;
		1783	begin
		1784	GetPaletteEntries(Source.Palette, 0, 256, PaletteEntries);
		1785	ColorTable := PaletteEntriesToRGBQuads(PaletteEntries);
		1786	UpdatePalette;
		1787
		1788	case GetObject(Source.Handle, SizeOf(Data), @Data) of
		1789	SizeOf(Windows.TBitmap):
4	daniel-mar	1790	begin
		1791	BitmapRec := @Data;
		1792	case BitmapRec^.bmBitsPixel of
		1793	16: PixelFormat := MakeDIBPixelFormat(5, 5, 5);
		1794	else
		1795	PixelFormat := MakeDIBPixelFormat(8, 8, 8);
1	daniel-mar	1796	end;
4	daniel-mar	1797	SetSize(BitmapRec^.bmWidth, BitmapRec^.bmHeight, BitmapRec^.bmBitsPixel);
		1798	end;
1	daniel-mar	1799	SizeOf(TDIBSection):
4	daniel-mar	1800	begin
		1801	DIBSectionRec := @Data;
		1802	if DIBSectionRec^.dsBm.bmBitsPixel >= 24 then
1	daniel-mar	1803	begin
4	daniel-mar	1804	PixelFormat := MakeDIBPixelFormat(8, 8, 8);
		1805	end
		1806	else
		1807	if DIBSectionRec^.dsBm.bmBitsPixel > 8 then
1	daniel-mar	1808	begin
4	daniel-mar	1809	PixelFormat := MakeDIBPixelFormatMask(DIBSectionRec^.dsBitfields[0], //correct I.Ceneff, thanks
1	daniel-mar	1810	DIBSectionRec^.dsBitfields[1], DIBSectionRec^.dsBitfields[2]);
4	daniel-mar	1811	end
		1812	else
1	daniel-mar	1813	begin
		1814	PixelFormat := MakeDIBPixelFormat(8, 8, 8);
		1815	end;
4	daniel-mar	1816	SetSize(DIBSectionRec^.dsBm.bmWidth, DIBSectionRec^.dsBm.bmHeight,
		1817	DIBSectionRec^.dsBm.bmBitsPixel);
		1818	end;
1	daniel-mar	1819	else
		1820	Exit;
		1821	end;
		1822
		1823	FillChar(PBits^, Size, 0);
		1824	Canvas.Draw(0, 0, Source);
		1825	end;
		1826
		1827	procedure AssignGraphic(Source: TGraphic);
4	daniel-mar	1828	{$IFDEF PNG_GRAPHICS}
		1829	var
		1830	alpha: TDIB;
		1831	png: {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF};
		1832	i, j: Integer;
		1833	q: pByteArray;
		1834	{$ENDIF}
1	daniel-mar	1835	begin
4	daniel-mar	1836	{$IFDEF PNG_GRAPHICS}
		1837	if Source is {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF} then
		1838	begin
		1839	alpha := TDIB.Create;
		1840	try
		1841	{png image}
		1842	png := {$IFDEF VER12UP}TPngImage{$ELSE}TPNGObject{$ENDIF}.Create;
		1843	try
		1844	png.Assign(Source);
		1845	if png.TransparencyMode = ptmPartial then
		1846	begin
		1847	Alpha.SetSize(png.Width, png.Height, 8);
		1848	{separate alpha}
		1849	for i := 0 to png.Height - 1 do
		1850	begin
		1851	q := png.AlphaScanline[i];
		1852	for j := 0 to png.Width - 1 do
		1853	alpha.Pixels[j,i] := q[j];
		1854	end;
		1855	end;
		1856	SetSize(png.Width, png.Height, 32);
		1857	FillChar(PBits^, Size, 0);
		1858	Canvas.Draw(0, 0, png);
		1859	Transparent := png.Transparent;
		1860	finally
		1861	png.Free;
		1862	end;
		1863	if not alpha.Empty then
		1864	AssignAlphaChannel(alpha);
		1865	finally
		1866	alpha.Free;
		1867	end;
		1868	end
		1869	else
		1870	{$ENDIF}
1	daniel-mar	1871	if Source is TBitmap then
		1872	AssignBitmap(TBitmap(Source))
		1873	else
		1874	begin
4	daniel-mar	1875	SetSize(Source.Width, Source.Height, 32);
1	daniel-mar	1876	FillChar(PBits^, Size, 0);
		1877	Canvas.Draw(0, 0, Source);
4	daniel-mar	1878	Transparent := Source.Transparent;
		1879	if not HasAlphaChannel then
		1880	begin
		1881	SetSize(Source.Width, Source.Height, 24);
		1882	FillChar(PBits^, Size, 0);
		1883	Canvas.Draw(0, 0, Source);
		1884	Transparent := Source.Transparent;
		1885	end
1	daniel-mar	1886	end;
		1887	end;
		1888
		1889	begin
4	daniel-mar	1890	if Source = nil then
1	daniel-mar	1891	begin
		1892	Clear;
		1893	end else if Source is TDIB then
		1894	begin
4	daniel-mar	1895	if Source <> Self then
1	daniel-mar	1896	SetImage(TDIB(Source).FImage);
		1897	end else if Source is TGraphic then
		1898	begin
		1899	AssignGraphic(TGraphic(Source));
		1900	end else if Source is TPicture then
		1901	begin
4	daniel-mar	1902	if TPicture(Source).Graphic <> nil then
1	daniel-mar	1903	AssignGraphic(TPicture(Source).Graphic)
		1904	else
		1905	Clear;
4	daniel-mar	1906	end else
1	daniel-mar	1907	inherited Assign(Source);
		1908	end;
		1909
4	daniel-mar	1910	procedure TDIB.Draw(ACanvas: TCanvas; const ARect: TRect);
1	daniel-mar	1911	var
		1912	OldPalette: HPalette;
		1913	OldMode: Integer;
		1914	begin
4	daniel-mar	1915	if Size > 0 then
1	daniel-mar	1916	begin
4	daniel-mar	1917	if PaletteCount > 0 then
1	daniel-mar	1918	begin
		1919	OldPalette := SelectPalette(ACanvas.Handle, Palette, False);
		1920	RealizePalette(ACanvas.Handle);
4	daniel-mar	1921	end
		1922	else
1	daniel-mar	1923	OldPalette := 0;
		1924	try
		1925	OldMode := SetStretchBltMode(ACanvas.Handle, COLORONCOLOR);
		1926	try
		1927	GdiFlush;
		1928	if FImage.FMemoryImage then
		1929	begin
4	daniel-mar	1930	with ARect do
		1931	begin
		1932	if StretchDIBits(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
		1933	0, 0, Self.Width, Self.Height, FImage.FPBits, FImage.FBitmapInfo^, DIB_RGB_COLORS, ACanvas.CopyMode) = 0 then
		1934	MessageBeep(1);
		1935	end;
		1936	end
		1937	else
1	daniel-mar	1938	begin
4	daniel-mar	1939	with ARect do
1	daniel-mar	1940	StretchBlt(ACanvas.Handle, Left, Top, Right - Left, Bottom - Top,
4	daniel-mar	1941	FImage.FDC, 0, 0, Self.Width, Self.Height, ACanvas.CopyMode);
1	daniel-mar	1942	end;
		1943	finally
		1944	SetStretchBltMode(ACanvas.Handle, OldMode);
		1945	end;
		1946	finally
		1947	SelectPalette(ACanvas.Handle, OldPalette, False);
		1948	end;
		1949	end;
		1950	end;
		1951
		1952	procedure TDIB.Clear;
		1953	begin
		1954	SetImage(EmptyDIBImage);
		1955	end;
		1956
		1957	procedure TDIB.CanvasChanging(Sender: TObject);
		1958	begin
		1959	Changing(False);
		1960	end;
		1961
		1962	procedure TDIB.Changing(MemoryImage: Boolean);
		1963	var
		1964	TempImage: TDIBSharedImage;
		1965	begin
4	daniel-mar	1966	if (FImage.RefCount > 1) or (FImage.FCompressed) or ((not MemoryImage) and (FImage.FMemoryImage)) then
1	daniel-mar	1967	begin
		1968	TempImage := TDIBSharedImage.Create;
		1969	try
		1970	TempImage.Decompress(FImage, FImage.FMemoryImage and MemoryImage);
		1971	except
		1972	TempImage.Free;
		1973	raise;
		1974	end;
		1975	SetImage(TempImage);
		1976	end;
		1977	end;
		1978
		1979	procedure TDIB.AllocHandle;
		1980	var
		1981	TempImage: TDIBSharedImage;
		1982	begin
		1983	if FImage.FMemoryImage then
		1984	begin
		1985	TempImage := TDIBSharedImage.Create;
		1986	try
		1987	TempImage.Decompress(FImage, False);
		1988	except
		1989	TempImage.Free;
		1990	raise;
		1991	end;
		1992	SetImage(TempImage);
		1993	end;
		1994	end;
		1995
		1996	procedure TDIB.Compress;
		1997	var
		1998	TempImage: TDIBSharedImage;
		1999	begin
		2000	if (not FImage.FCompressed) and (BitCount in [4, 8]) then
		2001	begin
		2002	TempImage := TDIBSharedImage.Create;
		2003	try
		2004	TempImage.Compress(FImage);
		2005	except
		2006	TempImage.Free;
		2007	raise;
		2008	end;
		2009	SetImage(TempImage);
		2010	end;
		2011	end;
		2012
		2013	procedure TDIB.Decompress;
		2014	var
		2015	TempImage: TDIBSharedImage;
		2016	begin
		2017	if FImage.FCompressed then
		2018	begin
		2019	TempImage := TDIBSharedImage.Create;
		2020	try
		2021	TempImage.Decompress(FImage, FImage.FMemoryImage);
		2022	except
		2023	TempImage.Free;
		2024	raise;
		2025	end;
		2026	SetImage(TempImage);
		2027	end;
		2028	end;
		2029
		2030	procedure TDIB.FreeHandle;
		2031	var
		2032	TempImage: TDIBSharedImage;
		2033	begin
		2034	if not FImage.FMemoryImage then
		2035	begin
		2036	TempImage := TDIBSharedImage.Create;
		2037	try
		2038	TempImage.Duplicate(FImage, True);
		2039	except
		2040	TempImage.Free;
		2041	raise;
		2042	end;
		2043	SetImage(TempImage);
		2044	end;
		2045	end;
		2046
4	daniel-mar	2047	type
		2048	PRGBA = ^TRGBA;
		2049	TRGBA = array[0..0] of Windows.TRGBQuad;
		2050
		2051	function TDIB.HasAlphaChannel: Boolean;
		2052	{give that DIB contain the alphachannel}
		2053	var
		2054	p: PRGBA;
		2055	X, Y: Integer;
		2056	begin
		2057	Result := True;
		2058	if BitCount = 32 then
		2059	for Y := 0 to Height - 1 do
		2060	begin
		2061	p := ScanLine[Y];
		2062	for X := 0 to Width - 1 do
		2063	begin
		2064	if p[X].rgbReserved <> $0 then Exit;
		2065	end
		2066	end;
		2067	Result := False;
		2068	end;
		2069
		2070	function TDIB.AssignAlphaChannel(ALPHA: TDIB; ForceResize: Boolean{$IFDEF VER4UP} = False{$ENDIF}): Boolean;
		2071	{copy alphachannel from other DIB or add from DIB8}
		2072	var
		2073	p32_0, p32_1: PRGBA;
		2074	p24: Pointer;
		2075	pB: PArrayByte;
		2076	X, Y: Integer;
		2077	tmpDIB, qAlpha: TDIB;
		2078	begin
		2079	Result := False;
		2080	if GetEmpty then Exit;
		2081	{Alphachannel can be copy into 32bit DIB only!}
		2082	if BitCount <> 32 then
		2083	begin
		2084	tmpDIB := TDIB.Create;
		2085	try
		2086	tmpDIB.Assign(Self);
		2087	Clear;
		2088	SetSize(tmpDIB.Width, tmpDIB.Height, 32);
		2089	Canvas.Draw(0, 0, tmpDIB);
		2090	finally
		2091	tmpDIB.Free;
		2092	end;
		2093	end;
		2094	qAlpha := TDIB.Create;
		2095	try
		2096	if not Assigned(Alpha) then Exit;
		2097	if ForceResize then
		2098	begin
		2099	{create temp}
		2100	tmpDIB := TDIB.Create;
		2101	try
		2102	{picture}
		2103	tmpDIB.Assign(ALPHA);
		2104	{resample size}
		2105	tmpDIB.DoResample(Width, Height, ftrBSpline);
		2106	{convert to greyscale}
		2107	tmpDIB.Greyscale(8);
		2108	{return picture to qAlpha}
		2109	qAlpha.Assign(tmpDIB);
		2110	finally
		2111	tmpDIB.Free;
		2112	end;
		2113	end
		2114	else
		2115	{Must be the same size!}
		2116	if not ((Width = ALPHA.Width) and (Height = ALPHA.Height)) then Exit
		2117	else qAlpha.Assign(ALPHA);
		2118	{It works now with qAlpha only}
		2119	case qAlpha.BitCount of
		2120	24:
		2121	begin
		2122	for Y := 0 to Height - 1 do
		2123	begin
		2124	p32_0 := ScanLine[Y];
		2125	p24 := qAlpha.ScanLine[Y];
		2126	for X := 0 to Width - 1 do with PBGR(p24)^ do
		2127	begin
		2128	p32_0[X].rgbReserved := Round(0.30 * R + 0.59 * G + 0.11 * B);
		2129	end
		2130	end;
		2131	end;
		2132	32:
		2133	begin
		2134	for Y := 0 to Height - 1 do
		2135	begin
		2136	p32_0 := ScanLine[Y];
		2137	p32_1 := qAlpha.ScanLine[Y];
		2138	for X := 0 to Width - 1 do
		2139	begin
		2140	p32_0[X].rgbReserved := p32_1[X].rgbReserved;
		2141	end
		2142	end;
		2143	end;
		2144	8:
		2145	begin
		2146	for Y := 0 to Height - 1 do
		2147	begin
		2148	p32_0 := ScanLine[Y];
		2149	pB := qAlpha.ScanLine[Y];
		2150	for X := 0 to Width - 1 do
		2151	begin
		2152	p32_0[X].rgbReserved := pB[X];
		2153	end
		2154	end;
		2155	end;
		2156	1:
		2157	begin
		2158	for Y := 0 to Height - 1 do
		2159	begin
		2160	p32_0 := ScanLine[Y];
		2161	pB := qAlpha.ScanLine[Y];
		2162	for X := 0 to Width - 1 do
		2163	begin
		2164	if pB[X] = 0 then
		2165	p32_0[X].rgbReserved := $FF
		2166	else
		2167	p32_0[X].rgbReserved := 0
		2168	end
		2169	end;
		2170	end;
		2171	else
		2172	Exit;
		2173	end;
		2174	Result := True;
		2175	finally
		2176	qAlpha.Free;
		2177	end;
		2178	end;
		2179
		2180	procedure TDIB.RetAlphaChannel(out oDIB: TDIB);
		2181	{Store alphachannel information into DIB8}
		2182	var
		2183	p0: PRGBA;
		2184	pB: PArrayByte;
		2185	X, Y: Integer;
		2186	begin
		2187	oDIB := nil;
16	daniel-mar	2188	if not HasAlphaChannel then Exit;
4	daniel-mar	2189	oDIB := TDIB.Create;
		2190	oDIB.SetSize(Width, Height, 8);
		2191	for Y := 0 to Height - 1 do
		2192	begin
		2193	p0 := ScanLine[Y];
		2194	pB := oDIB.ScanLine[Y];
		2195	for X := 0 to Width - 1 do
		2196	begin
		2197	pB[X] := p0[X].rgbReserved;
		2198	end
		2199	end;
		2200	end;
		2201
1	daniel-mar	2202	function TDIB.GetBitmapInfo: PBitmapInfo;
		2203	begin
		2204	Result := FImage.FBitmapInfo;
		2205	end;
		2206
		2207	function TDIB.GetBitmapInfoSize: Integer;
		2208	begin
		2209	Result := FImage.FBitmapInfoSize;
		2210	end;
		2211
		2212	function TDIB.GetCanvas: TCanvas;
		2213	begin
4	daniel-mar	2214	if (FCanvas = nil) or (FCanvas.Handle = 0) then
1	daniel-mar	2215	begin
		2216	AllocHandle;
		2217
		2218	FCanvas := TCanvas.Create;
		2219	FCanvas.Handle := FImage.FDC;
		2220	FCanvas.OnChanging := CanvasChanging;
		2221	end;
		2222	Result := FCanvas;
		2223	end;
		2224
		2225	function TDIB.GetEmpty: Boolean;
		2226	begin
4	daniel-mar	2227	Result := Size = 0;
1	daniel-mar	2228	end;
		2229
		2230	function TDIB.GetHandle: THandle;
		2231	begin
		2232	Changing(True);
		2233	Result := FImage.FHandle;
		2234	end;
		2235
		2236	function TDIB.GetHeight: Integer;
		2237	begin
		2238	Result := FHeight;
		2239	end;
		2240
		2241	function TDIB.GetPalette: HPalette;
		2242	begin
		2243	Result := FImage.GetPalette;
		2244	end;
		2245
		2246	function TDIB.GetPaletteCount: Integer;
		2247	begin
		2248	Result := FImage.FPaletteCount;
		2249	end;
		2250
		2251	function TDIB.GetPBits: Pointer;
		2252	begin
		2253	Changing(True);
		2254
		2255	if not FImage.FMemoryImage then
		2256	GDIFlush;
		2257	Result := FPBits;
		2258	end;
		2259
		2260	function TDIB.GetPBitsReadOnly: Pointer;
		2261	begin
		2262	if not FImage.FMemoryImage then
		2263	GDIFlush;
		2264	Result := FPBits;
		2265	end;
		2266
		2267	function TDIB.GetScanLine(Y: Integer): Pointer;
		2268	begin
		2269	Changing(True);
4	daniel-mar	2270	if (Y < 0) or (Y >= FHeight) then
1	daniel-mar	2271	raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]);
		2272
		2273	if not FImage.FMemoryImage then
		2274	GDIFlush;
4	daniel-mar	2275	Result := Pointer(Integer(FTopPBits) + Y * FNextLine);
1	daniel-mar	2276	end;
		2277
		2278	function TDIB.GetScanLineReadOnly(Y: Integer): Pointer;
		2279	begin
4	daniel-mar	2280	if (Y < 0) or (Y >= FHeight) then
1	daniel-mar	2281	raise EInvalidGraphicOperation.CreateFmt(SScanline, [Y]);
		2282
		2283	if not FImage.FMemoryImage then
		2284	GDIFlush;
4	daniel-mar	2285	Result := Pointer(Integer(FTopPBits) + Y * FNextLine);
1	daniel-mar	2286	end;
		2287
16	daniel-mar	2288	{$IFDEF VER16UP}
		2289	function TDIB.GetSupportsPartialTransparency: Boolean;
		2290	begin
		2291	Result := (FBitCount = 32) and HasAlphaChannel;
		2292	end;
		2293	{$ENDIF}
		2294
1	daniel-mar	2295	function TDIB.GetTopPBits: Pointer;
		2296	begin
		2297	Changing(True);
		2298
		2299	if not FImage.FMemoryImage then
		2300	GDIFlush;
		2301	Result := FTopPBits;
		2302	end;
		2303
		2304	function TDIB.GetTopPBitsReadOnly: Pointer;
		2305	begin
		2306	if not FImage.FMemoryImage then
		2307	GDIFlush;
		2308	Result := FTopPBits;
4	daniel-mar	2309	end;
1	daniel-mar	2310
16	daniel-mar	2311	function TDIB.GetTransparent: Boolean;
		2312	begin
		2313	Result := (FBitCount = 32) and HasAlphaChannel;
		2314	end;
		2315
1	daniel-mar	2316	function TDIB.GetWidth: Integer;
		2317	begin
		2318	Result := FWidth;
		2319	end;
		2320
		2321	const
		2322	Mask1: array[0..7] of DWORD = ($80, $40, $20, $10, $08, $04, $02, $01);
		2323	Mask1n: array[0..7] of DWORD = ($FFFFFF7F, $FFFFFFBF, $FFFFFFDF, $FFFFFFEF,
		2324	$FFFFFFF7, $FFFFFFFB, $FFFFFFFD, $FFFFFFFE);
		2325	Mask4: array[0..1] of DWORD = ($F0, $0F);
		2326	Mask4n: array[0..1] of DWORD = ($FFFFFF0F, $FFFFFFF0);
		2327
		2328	Shift1: array[0..7] of DWORD = (7, 6, 5, 4, 3, 2, 1, 0);
		2329	Shift4: array[0..1] of DWORD = (4, 0);
		2330
		2331	function TDIB.GetPixel(X, Y: Integer): DWORD;
		2332	begin
		2333	Decompress;
		2334
		2335	Result := 0;
4	daniel-mar	2336	if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
1	daniel-mar	2337	begin
		2338	case FBitCount of
4	daniel-mar	2339	1: Result := (PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
		2340	4: Result := ((PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]);
		2341	8: Result := PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X];
		2342	16: Result := PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X];
		2343	24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
		2344	Result := R or (G shl 8) or (B shl 16);
		2345	32: Result := PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X];
1	daniel-mar	2346	end;
		2347	end;
		2348	end;
		2349
4	daniel-mar	2350	function TDIB.GetRGBChannel: TDIB;
		2351	{Store RGB channel information into DIB24}
		2352	begin
		2353	Result := nil;
		2354	if Self.Empty then Exit;
		2355	Result := TDIB.Create;
		2356	Result.SetSize(Width, Height, 24);
		2357	Self.DrawOn(Bounds(0,0, Self.Width, Self.Height), Result.Canvas, 0, 0);
		2358	FFreeList.Add(Result);
		2359	end;
		2360
1	daniel-mar	2361	procedure TDIB.SetPixel(X, Y: Integer; Value: DWORD);
		2362	var
		2363	P: PByte;
		2364	begin
		2365	Changing(True);
		2366
4	daniel-mar	2367	if (X >= 0) and (X < FWidth) and (Y >= 0) and (Y < FHeight) then
1	daniel-mar	2368	begin
		2369	case FBitCount of
4	daniel-mar	2370	1: begin
		2371	P := @PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3];
		2372	P^ := (P^ and Mask1n[X and 7]) or ((Value and 1) shl Shift1[X and 7]);
		2373	end;
		2374	4: begin
		2375	P := (@PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X shr 3]);
		2376	P^ := ((P^ and Mask4n[X and 1]) or ((Value and 15) shl Shift4[X and 1]));
		2377	end;
		2378	8: PArrayByte(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
		2379	16: PArrayWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
		2380	24: with PArrayBGR(Integer(FTopPBits) + Y * FNextLine)[X] do
		2381	begin
		2382	B := Byte(Value shr 16);
		2383	G := Byte(Value shr 8);
		2384	R := Byte(Value);
		2385	end;
		2386	32: PArrayDWord(Integer(FTopPBits) + Y * FNextLine)[X] := Value;
1	daniel-mar	2387	end;
		2388	end;
		2389	end;
4	daniel-mar	2390
		2391	procedure TDIB.SetRGBChannel(const Value: TDIB);
		2392	var
		2393	alpha: TDIB;
		2394	begin
		2395	if Self.HasAlphaChannel then
		2396	try
		2397	RetAlphaChannel(alpha);
		2398	Self.SetSize(Value.Width, Value.Height, 32);
		2399	Value.DrawOn(Bounds(0,0,Value.Width, Value.Height), Self.Canvas, 0, 0);
		2400	Self.AssignAlphaChannel(alpha, True);
		2401	finally
		2402	alpha.Free;
		2403	end
		2404	else
		2405	Self.Assign(Value);
		2406	end;
		2407
1	daniel-mar	2408	procedure TDIB.DefineProperties(Filer: TFiler);
		2409	begin
		2410	inherited DefineProperties(Filer);
		2411	{ For interchangeability with an old version. }
		2412	Filer.DefineBinaryProperty('DIB', LoadFromStream, nil, False);
		2413	end;
		2414
		2415	type
4	daniel-mar	2416	{ TGlobalMemoryStream }
		2417
1	daniel-mar	2418	TGlobalMemoryStream = class(TMemoryStream)
		2419	private
		2420	FHandle: THandle;
		2421	public
		2422	constructor Create(AHandle: THandle);
		2423	destructor Destroy; override;
		2424	end;
		2425
		2426	constructor TGlobalMemoryStream.Create(AHandle: THandle);
		2427	begin
		2428	inherited Create;
		2429	FHandle := AHandle;
		2430	SetPointer(GlobalLock(AHandle), GlobalSize(AHandle));
		2431	end;
		2432
		2433	destructor TGlobalMemoryStream.Destroy;
		2434	begin
		2435	GlobalUnLock(FHandle);
		2436	SetPointer(nil, 0);
		2437	inherited Destroy;
		2438	end;
		2439
		2440	procedure TDIB.LoadFromClipboardFormat(AFormat: Word; AData: THandle;
		2441	APalette: HPALETTE);
		2442	var
		2443	Stream: TGlobalMemoryStream;
		2444	begin
		2445	Stream := TGlobalMemoryStream.Create(AData);
		2446	try
		2447	ReadData(Stream);
		2448	finally
		2449	Stream.Free;
		2450	end;
		2451	end;
		2452
		2453	const
4	daniel-mar	2454	BitmapFileType = Ord('B') + Ord('M') * $100;
1	daniel-mar	2455
		2456	procedure TDIB.LoadFromStream(Stream: TStream);
		2457	var
		2458	BF: TBitmapFileHeader;
		2459	i: Integer;
4	daniel-mar	2460	ImageJPEG: TJPEGImage;
1	daniel-mar	2461	begin
		2462	{ File header reading }
		2463	i := Stream.Read(BF, SizeOf(TBitmapFileHeader));
4	daniel-mar	2464	if i = 0 then Exit;
		2465	if i <> SizeOf(TBitmapFileHeader) then
1	daniel-mar	2466	raise EInvalidGraphic.Create(SInvalidDIB);
		2467
4	daniel-mar	2468	{ Is the head jpeg ?}
		2469
		2470	if BF.bfType = $D8FF then
		2471	begin
		2472	ImageJPEG := TJPEGImage.Create;
		2473	try
		2474	try
		2475	Stream.Position := 0;
		2476	ImageJPEG.LoadFromStream(Stream);
		2477	except
		2478	on EInvalidGraphic do ImageJPEG := nil;
		2479	end;
		2480	if ImageJPEG <> nil then
		2481	begin
		2482	{set size and bitcount in natural units of jpeg}
		2483	SetSize(ImageJPEG.Width, ImageJPEG.Height, 24);
		2484	Canvas.Draw(0, 0, ImageJPEG);
		2485	Exit
		2486	end;
		2487	finally
		2488	ImageJPEG.Free;
		2489	end;
		2490	end
		2491	else
1	daniel-mar	2492	{ Is the head 'BM'? }
4	daniel-mar	2493	if BF.bfType <> BitmapFileType then
		2494	raise EInvalidGraphic.Create(SInvalidDIB);
1	daniel-mar	2495
		2496	ReadData(Stream);
		2497	end;
		2498
		2499	procedure TDIB.ReadData(Stream: TStream);
		2500	var
		2501	TempImage: TDIBSharedImage;
		2502	begin
		2503	TempImage := TDIBSharedImage.Create;
		2504	try
		2505	TempImage.ReadData(Stream, FImage.FMemoryImage);
		2506	except
		2507	TempImage.Free;
		2508	raise;
		2509	end;
		2510	SetImage(TempImage);
		2511	end;
		2512
		2513	procedure TDIB.SaveToClipboardFormat(var AFormat: Word; var AData: THandle;
		2514	var APalette: HPALETTE);
		2515	var
		2516	P: Pointer;
		2517	Stream: TMemoryStream;
		2518	begin
		2519	AFormat := CF_DIB;
		2520	APalette := 0;
		2521
		2522	Stream := TMemoryStream.Create;
		2523	try
		2524	WriteData(Stream);
		2525
		2526	AData := GlobalAlloc(GHND, Stream.Size);
4	daniel-mar	2527	if AData = 0 then OutOfMemoryError;
1	daniel-mar	2528
		2529	P := GlobalLock(AData);
		2530	Move(Stream.Memory^, P^, Stream.Size);
		2531	GlobalUnLock(AData);
		2532	finally
		2533	Stream.Free;
		2534	end;
		2535	end;
		2536
		2537	procedure TDIB.SaveToStream(Stream: TStream);
		2538	var
		2539	BF: TBitmapFileHeader;
		2540	begin
		2541	if Empty then Exit;
		2542
		2543	with BF do
		2544	begin
4	daniel-mar	2545	bfType := BitmapFileType;
		2546	bfOffBits := SizeOf(TBitmapFileHeader) + BitmapInfoSize;
		2547	bfSize := bfOffBits + FImage.FBitmapInfo^.bmiHeader.biSizeImage;
1	daniel-mar	2548	bfReserved1 := 0;
		2549	bfReserved2 := 0;
16	daniel-mar	2550	if (FBitCount = 32) and (FImage.FBitmapInfo^.bmiHeader.biCompression <> 0) then FImage.FBitmapInfo^.bmiHeader.biCompression := 0; //corrext RGB error to RGBA
1	daniel-mar	2551	end;
16	daniel-mar	2552
1	daniel-mar	2553	Stream.WriteBuffer(BF, SizeOf(TBitmapFileHeader));
		2554
		2555	WriteData(Stream);
		2556	end;
		2557
		2558	procedure TDIB.WriteData(Stream: TStream);
		2559	begin
		2560	if Empty then Exit;
		2561
		2562	if not FImage.FMemoryImage then
		2563	GDIFlush;
		2564
		2565	Stream.WriteBuffer(FImage.FBitmapInfo^, FImage.FBitmapInfoSize);
		2566	Stream.WriteBuffer(FImage.FPBits^, FImage.FBitmapInfo.bmiHeader.biSizeImage);
		2567	end;
		2568
		2569	procedure TDIB.SetBitCount(Value: Integer);
		2570	begin
4	daniel-mar	2571	if Value <= 0 then
1	daniel-mar	2572	Clear
		2573	else
		2574	begin
		2575	if Empty then
		2576	begin
		2577	SetSize(Max(Width, 1), Max(Height, 1), Value)
4	daniel-mar	2578	end
		2579	else
1	daniel-mar	2580	begin
		2581	ConvertBitCount(Value);
		2582	end;
		2583	end;
		2584	end;
		2585
		2586	procedure TDIB.SetHeight(Value: Integer);
		2587	begin
4	daniel-mar	2588	if Value <= 0 then
1	daniel-mar	2589	Clear
		2590	else
		2591	begin
		2592	if Empty then
		2593	SetSize(Max(Width, 1), Value, 8)
		2594	else
		2595	SetSize(Width, Value, BitCount);
		2596	end;
		2597	end;
		2598
		2599	procedure TDIB.SetWidth(Value: Integer);
		2600	begin
4	daniel-mar	2601	if Value <= 0 then
1	daniel-mar	2602	Clear
		2603	else
		2604	begin
		2605	if Empty then
		2606	SetSize(Value, Max(Height, 1), 8)
		2607	else
		2608	SetSize(Value, Height, BitCount);
		2609	end;
		2610	end;
		2611
		2612	procedure TDIB.SetImage(Value: TDIBSharedImage);
		2613	begin
4	daniel-mar	2614	if FImage <> Value then
1	daniel-mar	2615	begin
4	daniel-mar	2616	if FCanvas <> nil then
1	daniel-mar	2617	FCanvas.Handle := 0;
4	daniel-mar	2618
1	daniel-mar	2619	FImage.Release;
		2620	FImage := Value;
		2621	FImage.Reference;
		2622
4	daniel-mar	2623	if FCanvas <> nil then
1	daniel-mar	2624	FCanvas.Handle := FImage.FDC;
		2625
		2626	ColorTable := FImage.FColorTable;
		2627	PixelFormat := FImage.FPixelFormat;
		2628
		2629	FBitCount := FImage.FBitCount;
		2630	FHeight := FImage.FHeight;
		2631	FNextLine := FImage.FNextLine;
		2632	FNowPixelFormat := FImage.FPixelFormat;
		2633	FPBits := FImage.FPBits;
		2634	FSize := FImage.FSize;
		2635	FTopPBits := FImage.FTopPBits;
		2636	FWidth := FImage.FWidth;
		2637	FWidthBytes := FImage.FWidthBytes;
		2638	end;
		2639	end;
		2640
		2641	procedure TDIB.SetNowPixelFormat(const Value: TDIBPixelFormat);
		2642	var
		2643	Temp: TDIB;
		2644	begin
		2645	if CompareMem(@Value, @FImage.FPixelFormat, SizeOf(TDIBPixelFormat)) then exit;
		2646
		2647	PixelFormat := Value;
		2648
		2649	Temp := TDIB.Create;
		2650	try
		2651	Temp.Assign(Self);
		2652	SetSize(Width, Height, BitCount);
		2653	Canvas.Draw(0, 0, Temp);
		2654	finally
		2655	Temp.Free;
		2656	end;
		2657	end;
		2658
		2659	procedure TDIB.SetPalette(Value: HPalette);
		2660	var
		2661	PaletteEntries: TPaletteEntries;
		2662	begin
		2663	GetPaletteEntries(Value, 0, 256, PaletteEntries);
		2664	DeleteObject(Value);
		2665
		2666	ColorTable := PaletteEntriesToRGBQuads(PaletteEntries);
		2667	UpdatePalette;
		2668	end;
		2669
		2670	procedure TDIB.SetSize(AWidth, AHeight, ABitCount: Integer);
		2671	var
		2672	TempImage: TDIBSharedImage;
		2673	begin
4	daniel-mar	2674	if (AWidth = Width) and (AHeight = Height) and (ABitCount = BitCount) and
		2675	(NowPixelFormat.RBitMask = PixelFormat.RBitMask) and
		2676	(NowPixelFormat.GBitMask = PixelFormat.GBitMask) and
		2677	(NowPixelFormat.BBitMask = PixelFormat.BBitMask) then Exit;
1	daniel-mar	2678
4	daniel-mar	2679	if (AWidth <= 0) or (AHeight <= 0) then
1	daniel-mar	2680	begin
		2681	Clear;
		2682	Exit;
		2683	end;
		2684
		2685	TempImage := TDIBSharedImage.Create;
		2686	try
		2687	TempImage.NewImage(AWidth, AHeight, ABitCount,
		2688	PixelFormat, ColorTable, FImage.FMemoryImage, False);
		2689	except
		2690	TempImage.Free;
		2691	raise;
		2692	end;
		2693	SetImage(TempImage);
		2694
		2695	PaletteModified := True;
		2696	end;
		2697
		2698	procedure TDIB.UpdatePalette;
		2699	var
		2700	Col: TRGBQuads;
		2701	begin
		2702	if CompareMem(@ColorTable, @FImage.FColorTable, SizeOf(ColorTable)) then Exit;
		2703
		2704	Col := ColorTable;
		2705	Changing(True);
		2706	ColorTable := Col;
		2707	FImage.SetColorTable(ColorTable);
		2708
		2709	PaletteModified := True;
		2710	end;
		2711
		2712	procedure TDIB.ConvertBitCount(ABitCount: Integer);
		2713	var
		2714	Temp: TDIB;
		2715
		2716	procedure CreateHalftonePalette(R, G, B: Integer);
		2717	var
		2718	i: Integer;
		2719	begin
4	daniel-mar	2720	for i := 0 to 255 do
1	daniel-mar	2721	with ColorTable[i] do
		2722	begin
4	daniel-mar	2723	rgbRed := ((i shr (G + B - 1)) and (1 shl R - 1)) * 255 div (1 shl R - 1);
		2724	rgbGreen := ((i shr (B - 1)) and (1 shl G - 1)) * 255 div (1 shl G - 1);
		2725	rgbBlue := ((i shr 0) and (1 shl B - 1)) * 255 div (1 shl B - 1);
1	daniel-mar	2726	end;
		2727	end;
		2728
		2729	procedure PaletteToPalette_Inc;
		2730	var
		2731	x, y: Integer;
		2732	i: DWORD;
		2733	SrcP, DestP: Pointer;
		2734	P: PByte;
		2735	begin
		2736	i := 0;
		2737
4	daniel-mar	2738	for y := 0 to Height - 1 do
1	daniel-mar	2739	begin
		2740	SrcP := Temp.ScanLine[y];
		2741	DestP := ScanLine[y];
		2742
4	daniel-mar	2743	for x := 0 to Width - 1 do
1	daniel-mar	2744	begin
		2745	case Temp.BitCount of
4	daniel-mar	2746	1:
		2747	begin
		2748	i := (PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7];
		2749	end;
		2750	4:
		2751	begin
		2752	i := (PArrayByte(SrcP)[X and 1] and Mask4[X and 1]) shr Shift4[X and 1];
		2753	end;
		2754	8:
		2755	begin
		2756	i := PByte(SrcP)^;
		2757	Inc(PByte(SrcP));
		2758	end;
1	daniel-mar	2759	end;
		2760
		2761	case BitCount of
4	daniel-mar	2762	1:
		2763	begin
		2764	P := @PArrayByte(DestP)[X shr 3];
		2765	P^ := (P^ and Mask1n[X and 7]) or (i shl Shift1[X shr 3]);
		2766	end;
		2767	4:
		2768	begin
		2769	P := @PArrayByte(DestP)[X shr 1];
		2770	P^ := (P^ and Mask4n[X and 1]) or (i shl Shift4[X and 1]);
		2771	end;
		2772	8:
		2773	begin
		2774	PByte(DestP)^ := i;
		2775	Inc(PByte(DestP));
		2776	end;
1	daniel-mar	2777	end;
		2778	end;
		2779	end;
		2780	end;
		2781
		2782	procedure PaletteToRGB_or_RGBToRGB;
		2783	var
		2784	x, y: Integer;
		2785	SrcP, DestP: Pointer;
		2786	cR, cG, cB: Byte;
		2787	begin
		2788	cR := 0;
		2789	cG := 0;
		2790	cB := 0;
		2791
4	daniel-mar	2792	for y := 0 to Height - 1 do
1	daniel-mar	2793	begin
		2794	SrcP := Temp.ScanLine[y];
		2795	DestP := ScanLine[y];
		2796
4	daniel-mar	2797	for x := 0 to Width - 1 do
1	daniel-mar	2798	begin
		2799	case Temp.BitCount of
4	daniel-mar	2800	1:
		2801	begin
		2802	with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
		2803	begin
		2804	cR := rgbRed;
		2805	cG := rgbGreen;
		2806	cB := rgbBlue;
1	daniel-mar	2807	end;
4	daniel-mar	2808	end;
		2809	4:
		2810	begin
		2811	with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
		2812	begin
		2813	cR := rgbRed;
		2814	cG := rgbGreen;
		2815	cB := rgbBlue;
1	daniel-mar	2816	end;
4	daniel-mar	2817	end;
		2818	8:
		2819	begin
		2820	with Temp.ColorTable[PByte(SrcP)^] do
		2821	begin
		2822	cR := rgbRed;
		2823	cG := rgbGreen;
		2824	cB := rgbBlue;
1	daniel-mar	2825	end;
4	daniel-mar	2826	Inc(PByte(SrcP));
		2827	end;
		2828	16:
		2829	begin
		2830	pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, cR, cG, cB);
		2831	Inc(PWord(SrcP));
		2832	end;
		2833	24:
		2834	begin
		2835	with PBGR(SrcP)^ do
		2836	begin
		2837	cR := R;
		2838	cG := G;
		2839	cB := B;
1	daniel-mar	2840	end;
		2841
4	daniel-mar	2842	Inc(PBGR(SrcP));
		2843	end;
		2844	32:
		2845	begin
		2846	pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, cR, cG, cB);
		2847	Inc(PDWORD(SrcP));
		2848	end;
1	daniel-mar	2849	end;
		2850
		2851	case BitCount of
4	daniel-mar	2852	16:
		2853	begin
		2854	PWord(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
		2855	Inc(PWord(DestP));
		2856	end;
		2857	24:
		2858	begin
		2859	with PBGR(DestP)^ do
		2860	begin
		2861	R := cR;
		2862	G := cG;
		2863	B := cB;
1	daniel-mar	2864	end;
4	daniel-mar	2865	Inc(PBGR(DestP));
		2866	end;
		2867	32:
		2868	begin
		2869	PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR, cG, cB);
		2870	Inc(PDWORD(DestP));
		2871	end;
1	daniel-mar	2872	end;
		2873	end;
		2874	end;
		2875	end;
		2876
		2877	begin
4	daniel-mar	2878	if Size = 0 then exit;
1	daniel-mar	2879
		2880	Temp := TDIB.Create;
		2881	try
		2882	Temp.Assign(Self);
		2883	SetSize(Temp.Width, Temp.Height, ABitCount);
		2884
4	daniel-mar	2885	if FImage = Temp.FImage then Exit;
1	daniel-mar	2886
4	daniel-mar	2887	if (Temp.BitCount <= 8) and (BitCount <= 8) then
1	daniel-mar	2888	begin
		2889	{ The image is converted from the palette color image into the palette color image. }
4	daniel-mar	2890	if Temp.BitCount <= BitCount then
1	daniel-mar	2891	begin
		2892	PaletteToPalette_Inc;
4	daniel-mar	2893	end
		2894	else
1	daniel-mar	2895	begin
		2896	case BitCount of
		2897	1: begin
4	daniel-mar	2898	ColorTable[0] := RGBQuad(0, 0, 0);
		2899	ColorTable[1] := RGBQuad(255, 255, 255);
		2900	end;
1	daniel-mar	2901	4: CreateHalftonePalette(1, 2, 1);
		2902	8: CreateHalftonePalette(3, 3, 2);
		2903	end;
		2904	UpdatePalette;
		2905
		2906	Canvas.Draw(0, 0, Temp);
		2907	end;
4	daniel-mar	2908	end
		2909	else
		2910	if (Temp.BitCount <= 8) and (BitCount > 8) then
		2911	begin
		2912	{ The image is converted from the palette color image into the rgb color image. }
		2913	PaletteToRGB_or_RGBToRGB;
		2914	end
		2915	else
		2916	if (Temp.BitCount > 8) and (BitCount <= 8) then
		2917	begin
		2918	{ The image is converted from the rgb color image into the palette color image. }
		2919	case BitCount of
		2920	1: begin
		2921	ColorTable[0] := RGBQuad(0, 0, 0);
		2922	ColorTable[1] := RGBQuad(255, 255, 255);
		2923	end;
		2924	4: CreateHalftonePalette(1, 2, 1);
		2925	8: CreateHalftonePalette(3, 3, 2);
		2926	end;
		2927	UpdatePalette;
1	daniel-mar	2928
4	daniel-mar	2929	Canvas.Draw(0, 0, Temp);
		2930	end
		2931	else
		2932	if (Temp.BitCount > 8) and (BitCount > 8) then
		2933	begin
		2934	{ The image is converted from the rgb color image into the rgb color image. }
		2935	PaletteToRGB_or_RGBToRGB;
		2936	end;
1	daniel-mar	2937	finally
		2938	Temp.Free;
		2939	end;
		2940	end;
		2941
		2942	{ Special effect }
		2943
		2944	procedure TDIB.StartProgress(const Name: string);
		2945	begin
		2946	FProgressName := Name;
		2947	FProgressOld := 0;
		2948	FProgressOldTime := GetTickCount;
		2949	FProgressY := 0;
		2950	FProgressOldY := 0;
		2951	Progress(Self, psStarting, 0, False, Rect(0, 0, Width, Height), FProgressName);
		2952	end;
		2953
		2954	procedure TDIB.EndProgress;
		2955	begin
		2956	Progress(Self, psEnding, 100, True, Rect(0, FProgressOldY, Width, Height), FProgressName);
		2957	end;
		2958
		2959	procedure TDIB.UpdateProgress(PercentY: Integer);
		2960	var
		2961	Redraw: Boolean;
		2962	Percent: DWORD;
		2963	begin
4	daniel-mar	2964	Redraw := (GetTickCount - FProgressOldTime > 200) and (FProgressY - FProgressOldY > 32) and
		2965	(((Height div 3 > Integer(FProgressY)) and (FProgressOldY = 0)) or (FProgressOldY <> 0));
1	daniel-mar	2966
4	daniel-mar	2967	Percent := PercentY * 100 div Height;
1	daniel-mar	2968
4	daniel-mar	2969	if (Percent <> FProgressOld) or (Redraw) then
1	daniel-mar	2970	begin
		2971	Progress(Self, psRunning, Percent, Redraw,
		2972	Rect(0, FProgressOldY, Width, FProgressY), FProgressName);
		2973	if Redraw then
		2974	begin
		2975	FProgressOldY := FProgressY;
		2976	FProgressOldTime := GetTickCount;
		2977	end;
		2978
		2979	FProgressOld := Percent;
		2980	end;
		2981
		2982	Inc(FProgressY);
		2983	end;
		2984
4	daniel-mar	2985	procedure TDIB.Mirror(MirrorX, MirrorY: Boolean);
		2986	var
		2987	x, y, Width2, c: Integer;
		2988	P1, P2, TempBuf: Pointer;
		2989	begin
		2990	if Empty then Exit;
		2991	if (not MirrorX) and (not MirrorY) then Exit;
		2992
		2993	if (not MirrorX) and (MirrorY) then
		2994	begin
		2995	GetMem(TempBuf, WidthBytes);
		2996	try
		2997	StartProgress('Mirror');
		2998	try
		2999	for y := 0 to Height shr 1 - 1 do
		3000	begin
		3001	P1 := ScanLine[y];
		3002	P2 := ScanLine[Height - y - 1];
		3003
		3004	Move(P1^, TempBuf^, WidthBytes);
		3005	Move(P2^, P1^, WidthBytes);
		3006	Move(TempBuf^, P2^, WidthBytes);
		3007
		3008	UpdateProgress(y * 2);
		3009	end;
		3010	finally
		3011	EndProgress;
		3012	end;
		3013	finally
		3014	FreeMem(TempBuf, WidthBytes);
		3015	end;
		3016	end
		3017	else
		3018	if (MirrorX) and (not MirrorY) then
		3019	begin
		3020	Width2 := Width shr 1;
		3021
		3022	StartProgress('Mirror');
		3023	try
		3024	for y := 0 to Height - 1 do
		3025	begin
		3026	P1 := ScanLine[y];
		3027
		3028	case BitCount of
		3029	1:
		3030	begin
		3031	for x := 0 to Width2 - 1 do
		3032	begin
		3033	c := Pixels[x, y];
		3034	Pixels[x, y] := Pixels[Width - x - 1, y];
		3035	Pixels[Width - x - 1, y] := c;
		3036	end;
		3037	end;
		3038	4:
		3039	begin
		3040	for x := 0 to Width2 - 1 do
		3041	begin
		3042	c := Pixels[x, y];
		3043	Pixels[x, y] := Pixels[Width - x - 1, y];
		3044	Pixels[Width - x - 1, y] := c;
		3045	end;
		3046	end;
		3047	8:
		3048	begin
		3049	P2 := Pointer(Integer(P1) + Width - 1);
		3050	for x := 0 to Width2 - 1 do
		3051	begin
		3052	PByte(@c)^ := PByte(P1)^;
		3053	PByte(P1)^ := PByte(P2)^;
		3054	PByte(P2)^ := PByte(@c)^;
		3055	Inc(PByte(P1));
		3056	Dec(PByte(P2));
		3057	end;
		3058	end;
		3059	16:
		3060	begin
		3061	P2 := Pointer(Integer(P1) + (Width - 1) * 2);
		3062	for x := 0 to Width2 - 1 do
		3063	begin
		3064	PWord(@c)^ := PWord(P1)^;
		3065	PWord(P1)^ := PWord(P2)^;
		3066	PWord(P2)^ := PWord(@c)^;
		3067	Inc(PWord(P1));
		3068	Dec(PWord(P2));
		3069	end;
		3070	end;
		3071	24:
		3072	begin
		3073	P2 := Pointer(Integer(P1) + (Width - 1) * 3);
		3074	for x := 0 to Width2 - 1 do
		3075	begin
		3076	PBGR(@c)^ := PBGR(P1)^;
		3077	PBGR(P1)^ := PBGR(P2)^;
		3078	PBGR(P2)^ := PBGR(@c)^;
		3079	Inc(PBGR(P1));
		3080	Dec(PBGR(P2));
		3081	end;
		3082	end;
		3083	32:
		3084	begin
		3085	P2 := Pointer(Integer(P1) + (Width - 1) * 4);
		3086	for x := 0 to Width2 - 1 do
		3087	begin
		3088	PDWORD(@c)^ := PDWORD(P1)^;
		3089	PDWORD(P1)^ := PDWORD(P2)^;
		3090	PDWORD(P2)^ := PDWORD(@c)^;
		3091	Inc(PDWORD(P1));
		3092	Dec(PDWORD(P2));
		3093	end;
		3094	end;
		3095	end;
		3096
		3097	UpdateProgress(y);
		3098	end;
		3099	finally
		3100	EndProgress;
		3101	end;
		3102	end
		3103	else
		3104	if (MirrorX) and (MirrorY) then
		3105	begin
		3106	StartProgress('Mirror');
		3107	try
		3108	for y := 0 to Height shr 1 - 1 do
		3109	begin
		3110	P1 := ScanLine[y];
		3111	P2 := ScanLine[Height - y - 1];
		3112
		3113	case BitCount of
		3114	1:
		3115	begin
		3116	for x := 0 to Width - 1 do
		3117	begin
		3118	c := Pixels[x, y];
		3119	Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
		3120	Pixels[Width - x - 1, Height - y - 1] := c;
		3121	end;
		3122	end;
		3123	4:
		3124	begin
		3125	for x := 0 to Width - 1 do
		3126	begin
		3127	c := Pixels[x, y];
		3128	Pixels[x, y] := Pixels[Width - x - 1, Height - y - 1];
		3129	Pixels[Width - x - 1, Height - y - 1] := c;
		3130	end;
		3131	end;
		3132	8:
		3133	begin
		3134	P2 := Pointer(Integer(P2) + Width - 1);
		3135	for x := 0 to Width - 1 do
		3136	begin
		3137	PByte(@c)^ := PByte(P1)^;
		3138	PByte(P1)^ := PByte(P2)^;
		3139	PByte(P2)^ := PByte(@c)^;
		3140	Inc(PByte(P1));
		3141	Dec(PByte(P2));
		3142	end;
		3143	end;
		3144	16:
		3145	begin
		3146	P2 := Pointer(Integer(P2) + (Width - 1) * 2);
		3147	for x := 0 to Width - 1 do
		3148	begin
		3149	PWord(@c)^ := PWord(P1)^;
		3150	PWord(P1)^ := PWord(P2)^;
		3151	PWord(P2)^ := PWord(@c)^;
		3152	Inc(PWord(P1));
		3153	Dec(PWord(P2));
		3154	end;
		3155	end;
		3156	24:
		3157	begin
		3158	P2 := Pointer(Integer(P2) + (Width - 1) * 3);
		3159	for x := 0 to Width - 1 do
		3160	begin
		3161	PBGR(@c)^ := PBGR(P1)^;
		3162	PBGR(P1)^ := PBGR(P2)^;
		3163	PBGR(P2)^ := PBGR(@c)^;
		3164	Inc(PBGR(P1));
		3165	Dec(PBGR(P2));
		3166	end;
		3167	end;
		3168	32:
		3169	begin
		3170	P2 := Pointer(Integer(P2) + (Width - 1) * 4);
		3171	for x := 0 to Width - 1 do
		3172	begin
		3173	PDWORD(@c)^ := PDWORD(P1)^;
		3174	PDWORD(P1)^ := PDWORD(P2)^;
		3175	PDWORD(P2)^ := PDWORD(@c)^;
		3176	Inc(PDWORD(P1));
		3177	Dec(PDWORD(P2));
		3178	end;
		3179	end;
		3180	end;
		3181
		3182	UpdateProgress(y * 2);
		3183	end;
		3184	finally
		3185	EndProgress;
		3186	end;
		3187	end;
		3188	end;
		3189
1	daniel-mar	3190	procedure TDIB.Blur(ABitCount: Integer; Radius: Integer);
		3191	type
		3192	TAve = record
		3193	cR, cG, cB: DWORD;
		3194	c: DWORD;
		3195	end;
		3196	TArrayAve = array[0..0] of TAve;
		3197
		3198	var
		3199	Temp: TDIB;
		3200
		3201	procedure AddAverage(Y, XCount: Integer; var Ave: TArrayAve);
		3202	var
		3203	X: Integer;
		3204	SrcP: Pointer;
		3205	AveP: ^TAve;
		3206	R, G, B: Byte;
		3207	begin
		3208	case Temp.BitCount of
4	daniel-mar	3209	1:
		3210	begin
		3211	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3212	AveP := @Ave;
		3213	for x := 0 to XCount - 1 do
		3214	begin
		3215	with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
1	daniel-mar	3216	begin
4	daniel-mar	3217	Inc(cR, rgbRed);
		3218	Inc(cG, rgbGreen);
		3219	Inc(cB, rgbBlue);
		3220	Inc(c);
1	daniel-mar	3221	end;
4	daniel-mar	3222	Inc(AveP);
1	daniel-mar	3223	end;
4	daniel-mar	3224	end;
		3225	4:
		3226	begin
		3227	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3228	AveP := @Ave;
		3229	for x := 0 to XCount - 1 do
		3230	begin
		3231	with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
1	daniel-mar	3232	begin
4	daniel-mar	3233	Inc(cR, rgbRed);
		3234	Inc(cG, rgbGreen);
		3235	Inc(cB, rgbBlue);
		3236	Inc(c);
1	daniel-mar	3237	end;
4	daniel-mar	3238	Inc(AveP);
1	daniel-mar	3239	end;
4	daniel-mar	3240	end;
		3241	8:
		3242	begin
		3243	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3244	AveP := @Ave;
		3245	for x := 0 to XCount - 1 do
		3246	begin
		3247	with Temp.ColorTable[PByte(SrcP)^], AveP^ do
1	daniel-mar	3248	begin
4	daniel-mar	3249	Inc(cR, rgbRed);
		3250	Inc(cG, rgbGreen);
		3251	Inc(cB, rgbBlue);
		3252	Inc(c);
1	daniel-mar	3253	end;
4	daniel-mar	3254	Inc(PByte(SrcP));
		3255	Inc(AveP);
1	daniel-mar	3256	end;
4	daniel-mar	3257	end;
		3258	16:
		3259	begin
		3260	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3261	AveP := @Ave;
		3262	for x := 0 to XCount - 1 do
		3263	begin
		3264	pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
		3265	with AveP^ do
1	daniel-mar	3266	begin
4	daniel-mar	3267	Inc(cR, R);
		3268	Inc(cG, G);
		3269	Inc(cB, B);
		3270	Inc(c);
1	daniel-mar	3271	end;
4	daniel-mar	3272	Inc(PWord(SrcP));
		3273	Inc(AveP);
1	daniel-mar	3274	end;
4	daniel-mar	3275	end;
		3276	24:
		3277	begin
		3278	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3279	AveP := @Ave;
		3280	for x := 0 to XCount - 1 do
		3281	begin
		3282	with PBGR(SrcP)^, AveP^ do
1	daniel-mar	3283	begin
4	daniel-mar	3284	Inc(cR, R);
		3285	Inc(cG, G);
		3286	Inc(cB, B);
		3287	Inc(c);
1	daniel-mar	3288	end;
4	daniel-mar	3289	Inc(PBGR(SrcP));
		3290	Inc(AveP);
1	daniel-mar	3291	end;
4	daniel-mar	3292	end;
		3293	32:
		3294	begin
		3295	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3296	AveP := @Ave;
		3297	for x := 0 to XCount - 1 do
		3298	begin
		3299	pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
		3300	with AveP^ do
1	daniel-mar	3301	begin
4	daniel-mar	3302	Inc(cR, R);
		3303	Inc(cG, G);
		3304	Inc(cB, B);
		3305	Inc(c);
1	daniel-mar	3306	end;
4	daniel-mar	3307	Inc(PDWORD(SrcP));
		3308	Inc(AveP);
1	daniel-mar	3309	end;
4	daniel-mar	3310	end;
1	daniel-mar	3311	end;
		3312	end;
		3313
		3314	procedure DeleteAverage(Y, XCount: Integer; var Ave: TArrayAve);
		3315	var
		3316	X: Integer;
		3317	SrcP: Pointer;
		3318	AveP: ^TAve;
		3319	R, G, B: Byte;
		3320	begin
		3321	case Temp.BitCount of
4	daniel-mar	3322	1:
		3323	begin
		3324	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3325	AveP := @Ave;
		3326	for x := 0 to XCount - 1 do
		3327	begin
		3328	with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 3)^ and Mask1[x and 7]) shr Shift1[x and 7]], AveP^ do
1	daniel-mar	3329	begin
4	daniel-mar	3330	Dec(cR, rgbRed);
		3331	Dec(cG, rgbGreen);
		3332	Dec(cB, rgbBlue);
		3333	Dec(c);
1	daniel-mar	3334	end;
4	daniel-mar	3335	Inc(AveP);
1	daniel-mar	3336	end;
4	daniel-mar	3337	end;
		3338	4:
		3339	begin
		3340	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3341	AveP := @Ave;
		3342	for x := 0 to XCount - 1 do
		3343	begin
		3344	with Temp.ColorTable[(PByte(Integer(SrcP) + X shr 1)^ and Mask4[x and 1]) shr Shift4[x and 1]], AveP^ do
1	daniel-mar	3345	begin
4	daniel-mar	3346	Dec(cR, rgbRed);
		3347	Dec(cG, rgbGreen);
		3348	Dec(cB, rgbBlue);
		3349	Dec(c);
1	daniel-mar	3350	end;
4	daniel-mar	3351	Inc(AveP);
1	daniel-mar	3352	end;
4	daniel-mar	3353	end;
		3354	8:
		3355	begin
		3356	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3357	AveP := @Ave;
		3358	for x := 0 to XCount - 1 do
		3359	begin
		3360	with Temp.ColorTable[PByte(SrcP)^], AveP^ do
1	daniel-mar	3361	begin
4	daniel-mar	3362	Dec(cR, rgbRed);
		3363	Dec(cG, rgbGreen);
		3364	Dec(cB, rgbBlue);
		3365	Dec(c);
1	daniel-mar	3366	end;
4	daniel-mar	3367	Inc(PByte(SrcP));
		3368	Inc(AveP);
1	daniel-mar	3369	end;
4	daniel-mar	3370	end;
		3371	16:
		3372	begin
		3373	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3374	AveP := @Ave;
		3375	for x := 0 to XCount - 1 do
		3376	begin
		3377	pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
		3378	with AveP^ do
1	daniel-mar	3379	begin
4	daniel-mar	3380	Dec(cR, R);
		3381	Dec(cG, G);
		3382	Dec(cB, B);
		3383	Dec(c);
1	daniel-mar	3384	end;
4	daniel-mar	3385	Inc(PWord(SrcP));
		3386	Inc(AveP);
1	daniel-mar	3387	end;
4	daniel-mar	3388	end;
		3389	24:
		3390	begin
		3391	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3392	AveP := @Ave;
		3393	for x := 0 to XCount - 1 do
		3394	begin
		3395	with PBGR(SrcP)^, AveP^ do
1	daniel-mar	3396	begin
4	daniel-mar	3397	Dec(cR, R);
		3398	Dec(cG, G);
		3399	Dec(cB, B);
		3400	Dec(c);
1	daniel-mar	3401	end;
4	daniel-mar	3402	Inc(PBGR(SrcP));
		3403	Inc(AveP);
1	daniel-mar	3404	end;
4	daniel-mar	3405	end;
		3406	32:
		3407	begin
		3408	SrcP := Pointer(Integer(Temp.TopPBits) + Y * Temp.NextLine);
		3409	AveP := @Ave;
		3410	for x := 0 to XCount - 1 do
		3411	begin
		3412	pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
		3413	with AveP^ do
1	daniel-mar	3414	begin
4	daniel-mar	3415	Dec(cR, R);
		3416	Dec(cG, G);
		3417	Dec(cB, B);
		3418	Dec(c);
1	daniel-mar	3419	end;
4	daniel-mar	3420	Inc(PDWORD(SrcP));
		3421	Inc(AveP);
1	daniel-mar	3422	end;
4	daniel-mar	3423	end;
1	daniel-mar	3424	end;
		3425	end;
		3426
		3427	procedure Blur_Radius_Other;
		3428	var
		3429	FirstX, LastX, FirstX2, LastX2, FirstY, LastY: Integer;
		3430	x, y, x2, y2, jx, jy: Integer;
		3431	Ave: TAve;
		3432	AveX: ^TArrayAve;
		3433	DestP: Pointer;
		3434	P: PByte;
		3435	begin
4	daniel-mar	3436	GetMem(AveX, Width * SizeOf(TAve));
1	daniel-mar	3437	try
4	daniel-mar	3438	FillChar(AveX^, Width * SizeOf(TAve), 0);
1	daniel-mar	3439
		3440	FirstX2 := -1;
		3441	LastX2 := -1;
		3442	FirstY := -1;
		3443	LastY := -1;
		3444
		3445	x := 0;
4	daniel-mar	3446	for x2 := -Radius to Radius do
1	daniel-mar	3447	begin
4	daniel-mar	3448	jx := x + x2;
		3449	if (jx >= 0) and (jx < Width) then
1	daniel-mar	3450	begin
4	daniel-mar	3451	if FirstX2 = -1 then FirstX2 := jx;
		3452	if LastX2 < jx then LastX2 := jx;
1	daniel-mar	3453	end;
		3454	end;
		3455
		3456	y := 0;
4	daniel-mar	3457	for y2 := -Radius to Radius do
1	daniel-mar	3458	begin
4	daniel-mar	3459	jy := y + y2;
		3460	if (jy >= 0) and (jy < Height) then
1	daniel-mar	3461	begin
4	daniel-mar	3462	if FirstY = -1 then FirstY := jy;
		3463	if LastY < jy then LastY := jy;
1	daniel-mar	3464	end;
		3465	end;
		3466
4	daniel-mar	3467	for y := FirstY to LastY do
1	daniel-mar	3468	AddAverage(y, Temp.Width, AveX^);
		3469
4	daniel-mar	3470	for y := 0 to Height - 1 do
1	daniel-mar	3471	begin
		3472	DestP := ScanLine[y];
		3473
		3474	{ The average is updated. }
4	daniel-mar	3475	if y - FirstY = Radius + 1 then
1	daniel-mar	3476	begin
		3477	DeleteAverage(FirstY, Temp.Width, AveX^);
		3478	Inc(FirstY);
		3479	end;
		3480
4	daniel-mar	3481	if LastY - y = Radius - 1 then
1	daniel-mar	3482	begin
4	daniel-mar	3483	Inc(LastY); if LastY >= Height then LastY := Height - 1;
1	daniel-mar	3484	AddAverage(LastY, Temp.Width, AveX^);
		3485	end;
		3486
		3487	{ The average is calculated again. }
		3488	FirstX := FirstX2;
		3489	LastX := LastX2;
		3490
		3491	FillChar(Ave, SizeOf(Ave), 0);
4	daniel-mar	3492	for x := FirstX to LastX do
1	daniel-mar	3493	with AveX[x] do
		3494	begin
		3495	Inc(Ave.cR, cR);
		3496	Inc(Ave.cG, cG);
		3497	Inc(Ave.cB, cB);
		3498	Inc(Ave.c, c);
		3499	end;
		3500
4	daniel-mar	3501	for x := 0 to Width - 1 do
1	daniel-mar	3502	begin
		3503	{ The average is updated. }
4	daniel-mar	3504	if x - FirstX = Radius + 1 then
1	daniel-mar	3505	begin
		3506	with AveX[FirstX] do
		3507	begin
		3508	Dec(Ave.cR, cR);
		3509	Dec(Ave.cG, cG);
		3510	Dec(Ave.cB, cB);
		3511	Dec(Ave.c, c);
		3512	end;
		3513	Inc(FirstX);
		3514	end;
		3515
4	daniel-mar	3516	if LastX - x = Radius - 1 then
1	daniel-mar	3517	begin
4	daniel-mar	3518	Inc(LastX); if LastX >= Width then LastX := Width - 1;
1	daniel-mar	3519	with AveX[LastX] do
		3520	begin
		3521	Inc(Ave.cR, cR);
		3522	Inc(Ave.cG, cG);
		3523	Inc(Ave.cB, cB);
		3524	Inc(Ave.c, c);
		3525	end;
		3526	end;
		3527
		3528	{ The average is written. }
		3529	case BitCount of
4	daniel-mar	3530	1:
		3531	begin
		3532	P := @PArrayByte(DestP)[X shr 3];
		3533	with Ave do
		3534	P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(((cR + cG + cB) div c) div 3 > 127)) shl Shift1[X and 7]);
		3535	end;
		3536	4:
		3537	begin
		3538	P := @PArrayByte(DestP)[X shr 1];
		3539	with Ave do
		3540	P^ := (P^ and Mask4n[X and 1]) or (((((cR + cG + cB) div c) div 3) shr 4) shl Shift4[X and 1]);
		3541	end;
		3542	8:
		3543	begin
		3544	with Ave do
		3545	PByte(DestP)^ := ((cR + cG + cB) div c) div 3;
		3546	Inc(PByte(DestP));
		3547	end;
		3548	16:
		3549	begin
		3550	with Ave do
		3551	PWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
		3552	Inc(PWORD(DestP));
		3553	end;
		3554	24:
		3555	begin
		3556	with PBGR(DestP)^, Ave do
		3557	begin
		3558	R := cR div c;
		3559	G := cG div c;
		3560	B := cB div c;
1	daniel-mar	3561	end;
4	daniel-mar	3562	Inc(PBGR(DestP));
		3563	end;
		3564	32:
		3565	begin
		3566	with Ave do
		3567	PDWORD(DestP)^ := pfRGB(NowPixelFormat, cR div c, cG div c, cB div c);
		3568	Inc(PDWORD(DestP));
		3569	end;
1	daniel-mar	3570	end;
		3571	end;
		3572
		3573	UpdateProgress(y);
		3574	end;
		3575	finally
		3576	FreeMem(AveX);
		3577	end;
		3578	end;
		3579
		3580	var
		3581	i, j: Integer;
		3582	begin
4	daniel-mar	3583	if Empty or (Radius = 0) then Exit;
1	daniel-mar	3584
		3585	Radius := Abs(Radius);
		3586
		3587	StartProgress('Blur');
		3588	try
		3589	Temp := TDIB.Create;
		3590	try
		3591	Temp.Assign(Self);
		3592	SetSize(Width, Height, ABitCount);
		3593
4	daniel-mar	3594	if ABitCount <= 8 then
1	daniel-mar	3595	begin
		3596	FillChar(ColorTable, SizeOf(ColorTable), 0);
4	daniel-mar	3597	for i := 0 to (1 shl ABitCount) - 1 do
1	daniel-mar	3598	begin
4	daniel-mar	3599	j := i * (1 shl (8 - ABitCount));
1	daniel-mar	3600	j := j or (j shr ABitCount);
		3601	ColorTable[i] := RGBQuad(j, j, j);
		3602	end;
		3603	UpdatePalette;
		3604	end;
		3605
		3606	Blur_Radius_Other;
		3607	finally
		3608	Temp.Free;
		3609	end;
		3610	finally
		3611	EndProgress;
		3612	end;
		3613	end;
16	daniel-mar	3614	(*
4	daniel-mar	3615	procedure TDIB.Negative;
		3616	var
		3617	i, i2: Integer;
		3618	P: Pointer;
		3619	begin
		3620	if Empty then exit;
		3621
		3622	if BitCount <= 8 then
		3623	begin
		3624	for i := 0 to 255 do
		3625	with ColorTable[i] do
		3626	begin
		3627	rgbRed := 255 - rgbRed;
		3628	rgbGreen := 255 - rgbGreen;
		3629	rgbBlue := 255 - rgbBlue;
		3630	end;
		3631	UpdatePalette;
		3632	end else
		3633	begin
		3634	P := PBits;
		3635	i2 := Size;
		3636	asm
		3637	mov ecx,i2
		3638	mov eax,P
		3639	mov edx,ecx
		3640
		3641	{ Unit of DWORD. }
		3642	@@qword_skip:
		3643	shr ecx,2
		3644	jz @@dword_skip
		3645
		3646	dec ecx
		3647	@@dword_loop:
		3648	not dword ptr [eax+ecx*4]
		3649	dec ecx
		3650	jnl @@dword_loop
		3651
		3652	mov ecx,edx
		3653	shr ecx,2
		3654	add eax,ecx*4
		3655
		3656	{ Unit of Byte. }
		3657	@@dword_skip:
		3658	mov ecx,edx
		3659	and ecx,3
		3660	jz @@byte_skip
		3661
		3662	dec ecx
		3663	@@loop_byte:
		3664	not byte ptr [eax+ecx]
		3665	dec ecx
		3666	jnl @@loop_byte
		3667
		3668	@@byte_skip:
		3669	end;
		3670	end;
		3671	end;
16	daniel-mar	3672	*)
		3673	procedure TDIB.Negative;
		3674	var
		3675	i: Integer;
		3676	P: Pointer;
		3677	i2: Integer;
		3678	begin
		3679	if Empty then Exit;
4	daniel-mar	3680
16	daniel-mar	3681	if BitCount <= 8 then
		3682	begin
		3683	for i := 0 to 255 do
		3684	with ColorTable[i] do
		3685	begin
		3686	rgbRed := 255 - rgbRed;
		3687	rgbGreen := 255 - rgbGreen;
		3688	rgbBlue := 255 - rgbBlue;
		3689	end;
		3690	UpdatePalette;
		3691	end
		3692	else
		3693	begin
		3694	P := PBits;
		3695	i2 := Size;
		3696	for i := 0 to i2-1 do
		3697	begin
		3698	PByteArray(P)^[i] := not PByteArray(P)^[i];
		3699	end;
		3700	end;
		3701	end;
		3702
1	daniel-mar	3703	procedure TDIB.Greyscale(ABitCount: Integer);
		3704	var
		3705	YTblR, YTblG, YTblB: array[0..255] of Byte;
		3706	i, j, x, y: Integer;
		3707	c: DWORD;
		3708	R, G, B: Byte;
		3709	Temp: TDIB;
		3710	DestP, SrcP: Pointer;
		3711	P: PByte;
		3712	begin
4	daniel-mar	3713	if Empty then Exit;
1	daniel-mar	3714
		3715	Temp := TDIB.Create;
		3716	try
		3717	Temp.Assign(Self);
		3718	SetSize(Width, Height, ABitCount);
		3719
4	daniel-mar	3720	if ABitCount <= 8 then
1	daniel-mar	3721	begin
		3722	FillChar(ColorTable, SizeOf(ColorTable), 0);
4	daniel-mar	3723	for i := 0 to (1 shl ABitCount) - 1 do
1	daniel-mar	3724	begin
4	daniel-mar	3725	j := i * (1 shl (8 - ABitCount));
1	daniel-mar	3726	j := j or (j shr ABitCount);
		3727	ColorTable[i] := RGBQuad(j, j, j);
		3728	end;
		3729	UpdatePalette;
		3730	end;
		3731
4	daniel-mar	3732	for i := 0 to 255 do
1	daniel-mar	3733	begin
4	daniel-mar	3734	YTblR[i] := Trunc(0.3588 * i);
		3735	YTblG[i] := Trunc(0.4020 * i);
		3736	YTblB[i] := Trunc(0.2392 * i);
1	daniel-mar	3737	end;
		3738
		3739	c := 0;
		3740
		3741	StartProgress('Greyscale');
		3742	try
4	daniel-mar	3743	for y := 0 to Height - 1 do
1	daniel-mar	3744	begin
		3745	DestP := ScanLine[y];
		3746	SrcP := Temp.ScanLine[y];
		3747
4	daniel-mar	3748	for x := 0 to Width - 1 do
1	daniel-mar	3749	begin
		3750	case Temp.BitCount of
4	daniel-mar	3751	1:
		3752	begin
		3753	with Temp.ColorTable[(PArrayByte(SrcP)[X shr 3] and Mask1[X and 7]) shr Shift1[X and 7]] do
		3754	c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
		3755	end;
		3756	4:
		3757	begin
		3758	with Temp.ColorTable[(PArrayByte(SrcP)[X shr 1] and Mask4[X and 1]) shr Shift4[X and 1]] do
		3759	c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
		3760	end;
		3761	8:
		3762	begin
		3763	with Temp.ColorTable[PByte(SrcP)^] do
		3764	c := YTblR[rgbRed] + YTblG[rgbGreen] + YTblB[rgbBlue];
		3765	Inc(PByte(SrcP));
		3766	end;
		3767	16:
		3768	begin
		3769	pfGetRGB(Temp.NowPixelFormat, PWord(SrcP)^, R, G, B);
		3770	c := YTblR[R] + YTblR[G] + YTblR[B];
		3771	Inc(PWord(SrcP));
		3772	end;
		3773	24:
		3774	begin
		3775	with PBGR(SrcP)^ do
		3776	c := YTblR[R] + YTblG[G] + YTblB[B];
		3777	Inc(PBGR(SrcP));
		3778	end;
		3779	32:
		3780	begin
		3781	pfGetRGB(Temp.NowPixelFormat, PDWORD(SrcP)^, R, G, B);
		3782	c := YTblR[R] + YTblR[G] + YTblR[B];
		3783	Inc(PDWORD(SrcP));
		3784	end;
1	daniel-mar	3785	end;
		3786
		3787	case BitCount of
4	daniel-mar	3788	1:
		3789	begin
		3790	P := @PArrayByte(DestP)[X shr 3];
		3791	P^ := (P^ and Mask1n[X and 7]) or (DWORD(Ord(c > 127)) shl Shift1[X and 7]);
		3792	end;
		3793	4:
		3794	begin
		3795	P := @PArrayByte(DestP)[X shr 1];
		3796	P^ := (P^ and Mask4n[X and 1]) or ((c shr 4) shl Shift4[X and 1]);
		3797	end;
		3798	8:
		3799	begin
		3800	PByte(DestP)^ := c;
		3801	Inc(PByte(DestP));
		3802	end;
		3803	16:
		3804	begin
		3805	PWord(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
		3806	Inc(PWord(DestP));
		3807	end;
		3808	24:
		3809	begin
		3810	with PBGR(DestP)^ do
		3811	begin
		3812	R := c;
		3813	G := c;
		3814	B := c;
1	daniel-mar	3815	end;
4	daniel-mar	3816	Inc(PBGR(DestP));
		3817	end;
		3818	32:
		3819	begin
		3820	PDWORD(DestP)^ := pfRGB(NowPixelFormat, c, c, c);
		3821	Inc(PDWORD(DestP));
		3822	end;
1	daniel-mar	3823	end;
		3824	end;
		3825
		3826	UpdateProgress(y);
		3827	end;
		3828	finally
		3829	EndProgress;
		3830	end;
		3831	finally
		3832	Temp.Free;
		3833	end;
		3834	end;
		3835
4	daniel-mar	3836	//--------------------------------------------------------------------------------------------------
		3837	// Version : 0.1 - 26/06/2000 //
		3838	// Version : 0.2 - 04/07/2000 //
		3839	// At someone's request, i have added 3 news effects : //
		3840	// 1 - Rotate //
		3841	// 2 - SplitBlur //
		3842	// 3 - GaussianBlur //
		3843	//--------------------------------------------------------------------------------------------------
		3844	// - NEW SPECIAL EFFECT - (English) //
		3845	//--------------------------------------------------------------------------------------------------
		3846	// At the start, my idea was to create a component derived from TCustomDXDraw. Unfortunately, //
		3847	// it's impossible to run a graphic component (derived from TCustomDXDraw) in a conception's //
		3848	// mode (i don't success, but perhaps, somebody know how doing ! In that case, please help me !!!)//
		3849	// Then, i'm used the DIB's unit for my work, but this unit is poor in special effect. Knowing a //
		3850	// library with more effect, i'm undertaked to import this library in DIB's unit. You can see the //
		3851	// FastLib library at : //
		3852	// //
		3853	// -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody //
		3854	// //
		3855	// It was very difficult, because implementation's graphic was very different that DIB's unit. //
		3856	// Sometimes, i'm deserted the possibility of original effect, particularly in conversion of DIB //
		3857	// whith 256, 16 and 2 colors. If someone can implement this fonctionnality, thanks to tell me //
		3858	// how this miracle is possible !!! //
		3859	// All these procedures are translated and adapted by : //
		3860	// //
		3861	// -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org //
		3862	// //
		3863	// IMPORTANT : These procedures don't modify the DIB's unit structure //
		3864	// Nota Bene : I don't implement these type of graphics (32 and 16 bit per pixels), //
		3865	// for one reason : I haven't bitmaps of this type !!! //
		3866	//--------------------------------------------------------------------------------------------------
		3867	//--------------------------------------------------------------------------------------------------
		3868	// - NOUVEAUX EFFETS SPECIAUX - (Fran�ais) //
		3869	//--------------------------------------------------------------------------------------------------
		3870	// Au commencement, mon id�e �tait de d�river un composant de TCustomDXDraw. Malheureusement, //
		3871	// c'est impossible de faire fonctionner un composant graphique (deriv� de TCustomDXDraw) en mode //
		3872	// conception (je n'y suis pas parvenu, mais peut-�tre, que quelqu'un sait comment faire ! Dans //
		3873	// ce cas, vous seriez aimable de m'aider !!!) //
		3874	// Alors, j'ai utilis� l'unit� DIB pour mon travail,mais celle-ci est pauvre en effet sp�ciaux. //
		3875	// Connaissant une librairie avec beaucoup plus d'effets sp�ciaux, j'ai entrepris d'importer //
		3876	// cette librairie dans l'unit� DIB. Vous pouvez voir la librairie FastLib � : //
		3877	// //
		3878	// -> Gordon Alex Cowie <gfody@jps.net> www.jps.net/gfody //
		3879	// //
		3880	// C'�tait tr�s difficile car l'impl�mentation graphique est tr�s diff�rente de l'unit� DIB. //
		3881	// Parfois, j'ai abandonn� les possibilit�s de l'effet original, particuli�rement dans la //
		3882	// conversion des DIB avec 256, 16 et 2 couleurs. Si quelqu'un arrive � impl�menter ces //
		3883	// fonctionnalit�s, merci de me dire comment ce miracle est possible !!! //
		3884	// Toutes ces proc�dures ont �t� traduites et adapt�es par: //
		3885	// //
		3886	// -> Mickey (Michel HIBON) <mhibon@ifrance.com> http://mickey.tsx.org //
		3887	// //
		3888	// IMPORTANT : Ces proc�dures ne modifient pas la structure de l'unit� DIB //
		3889	// Nota Bene : Je n'ai pas impl�ment� ces types de graphiques (32 et 16 bit par pixels), //
		3890	// pour une raison : je n'ai pas de bitmap de ce type !!! //
		3891	//--------------------------------------------------------------------------------------------------
		3892
		3893	function TDIB.IntToColor(i: Integer): TBGR;
		3894	begin
		3895	Result.b := i shr 16;
		3896	Result.g := i shr 8;
		3897	Result.r := i;
		3898	end;
		3899
		3900	function TDIB.Interval(iMin, iMax, iValue: Integer; iMark: Boolean): Integer;
		3901	begin
		3902	if iMark then
		3903	begin
		3904	if iValue < iMin then
		3905	Result := iMin
		3906	else
		3907	if iValue > iMax then
		3908	Result := iMax
		3909	else
		3910	Result := iValue;
		3911	end
		3912	else
		3913	begin
		3914	if iValue < iMin then
		3915	Result := iMin
		3916	else
		3917	if iValue > iMax then
		3918	Result := iMin
		3919	else
		3920	Result := iValue;
		3921	end;
		3922	end;
		3923
		3924	procedure TDIB.Contrast(Amount: Integer);
1	daniel-mar	3925	var
4	daniel-mar	3926	x, y: Integer;
		3927	Table1: array[0..255] of Byte;
		3928	i: Byte;
		3929	S, D: pointer;
		3930	Temp1: TDIB;
		3931	color: DWORD;
		3932	P: PByte;
		3933	R, G, B: Byte;
1	daniel-mar	3934	begin
4	daniel-mar	3935	D := nil;
		3936	S := nil;
		3937	Temp1 := nil;
		3938	for i := 0 to 126 do
		3939	begin
		3940	y := (Abs(128 - i) * Amount) div 256;
		3941	Table1[i] := IntToByte(i - y);
		3942	end;
		3943	for i := 127 to 255 do
		3944	begin
		3945	y := (Abs(128 - i) * Amount) div 256;
		3946	Table1[i] := IntToByte(i + y);
		3947	end;
		3948	case BitCount of
		3949	32: Exit; // I haven't bitmap of this type ! Sorry
		3950	24: ; // nothing to do
		3951	16: ; // I have an artificial bitmap for this type ! i don't sure that it works
		3952	8, 4:
		3953	begin
		3954	Temp1 := TDIB.Create;
		3955	Temp1.Assign(self);
		3956	Temp1.SetSize(Width, Height, BitCount);
		3957	for i := 0 to 255 do
		3958	begin
		3959	with ColorTable[i] do
		3960	begin
		3961	rgbRed := IntToByte(Table1[rgbRed]);
		3962	rgbGreen := IntToByte(Table1[rgbGreen]);
		3963	rgbBlue := IntToByte(Table1[rgbBlue]);
		3964	end;
		3965	end;
		3966	UpdatePalette;
		3967	end;
		3968	else
		3969	// if the number of pixel is equal to 1 then exit of procedure
		3970	Exit;
		3971	end;
		3972	for y := 0 to Pred(Height) do
		3973	begin
		3974	case BitCount of
		3975	24, 16: D := ScanLine[y];
		3976	8, 4:
		3977	begin
		3978	D := Temp1.ScanLine[y];
		3979	S := Temp1.ScanLine[y];
		3980	end;
		3981	else
		3982	end;
		3983	for x := 0 to Pred(Width) do
		3984	begin
		3985	case BitCount of
		3986	32: ;
		3987	24:
		3988	begin
		3989	PBGR(D)^.B := Table1[PBGR(D)^.B];
		3990	PBGR(D)^.G := Table1[PBGR(D)^.G];
		3991	PBGR(D)^.R := Table1[PBGR(D)^.R];
		3992	Inc(PBGR(D));
		3993	end;
		3994	16:
		3995	begin
		3996	pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
		3997	PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
		3998	Inc(PWord(D));
		3999	end;
		4000	8:
		4001	begin
		4002	with Temp1.ColorTable[PByte(S)^] do
		4003	color := rgbRed + rgbGreen + rgbBlue;
		4004	Inc(PByte(S));
		4005	PByte(D)^ := color;
		4006	Inc(PByte(D));
		4007	end;
		4008	4:
		4009	begin
		4010	with Temp1.ColorTable[PByte(S)^] do
		4011	color := rgbRed + rgbGreen + rgbBlue;
		4012	Inc(PByte(S));
		4013	P := @PArrayByte(D)[X shr 1];
		4014	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4015	end;
		4016	else
		4017	end;
		4018	end;
		4019	end;
		4020	case BitCount of
		4021	8, 4: Temp1.Free;
		4022	else
		4023	end;
		4024	end;
1	daniel-mar	4025
4	daniel-mar	4026	procedure TDIB.Saturation(Amount: Integer);
		4027	var
		4028	Grays: array[0..767] of Integer;
		4029	Alpha: array[0..255] of Word;
		4030	Gray, x, y: Integer;
		4031	i: Byte;
		4032	S, D: pointer;
		4033	Temp1: TDIB;
		4034	color: DWORD;
		4035	P: PByte;
		4036	R, G, B: Byte;
		4037	begin
		4038	D := nil;
		4039	S := nil;
		4040	Temp1 := nil;
		4041	for i := 0 to 255 do
		4042	Alpha[i] := (i * Amount) shr 8;
		4043	x := 0;
		4044	for i := 0 to 255 do
1	daniel-mar	4045	begin
4	daniel-mar	4046	Gray := i - Alpha[i];
		4047	Grays[x] := Gray;
		4048	Inc(x);
		4049	Grays[x] := Gray;
		4050	Inc(x);
		4051	Grays[x] := Gray;
		4052	Inc(x);
		4053	end;
		4054	case BitCount of
		4055	32: Exit; // I haven't bitmap of this type ! Sorry
		4056	24: ; // nothing to do
		4057	16: ; // I have an artificial bitmap for this type ! i don't sure that it works
		4058	8, 4:
		4059	begin
		4060	Temp1 := TDIB.Create;
		4061	Temp1.Assign(self);
		4062	Temp1.SetSize(Width, Height, BitCount);
		4063	for i := 0 to 255 do
1	daniel-mar	4064	begin
4	daniel-mar	4065	with ColorTable[i] do
		4066	begin
		4067	Gray := Grays[rgbRed + rgbGreen + rgbBlue];
		4068	rgbRed := IntToByte(Gray + Alpha[rgbRed]);
		4069	rgbGreen := IntToByte(Gray + Alpha[rgbGreen]);
		4070	rgbBlue := IntToByte(Gray + Alpha[rgbBlue]);
		4071	end;
		4072	end;
		4073	UpdatePalette;
		4074	end;
		4075	else
		4076	// if the number of pixel is equal to 1 then exit of procedure
		4077	Exit;
		4078	end;
		4079	for y := 0 to Pred(Height) do
		4080	begin
		4081	case BitCount of
		4082	24, 16: D := ScanLine[y];
		4083	8, 4:
		4084	begin
		4085	D := Temp1.ScanLine[y];
		4086	S := Temp1.ScanLine[y];
		4087	end;
		4088	else
		4089	end;
		4090	for x := 0 to Pred(Width) do
		4091	begin
		4092	case BitCount of
		4093	32: ;
		4094	24:
		4095	begin
		4096	Gray := Grays[PBGR(D)^.R + PBGR(D)^.G + PBGR(D)^.B];
		4097	PBGR(D)^.B := IntToByte(Gray + Alpha[PBGR(D)^.B]);
		4098	PBGR(D)^.G := IntToByte(Gray + Alpha[PBGR(D)^.G]);
		4099	PBGR(D)^.R := IntToByte(Gray + Alpha[PBGR(D)^.R]);
		4100	Inc(PBGR(D));
		4101	end;
		4102	16:
		4103	begin
		4104	pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
		4105	PWord(D)^ := IntToByte(Gray + Alpha[B]) + IntToByte(Gray + Alpha[G]) +
		4106	IntToByte(Gray + Alpha[R]);
		4107	Inc(PWord(D));
		4108	end;
		4109	8:
		4110	begin
		4111	with Temp1.ColorTable[PByte(S)^] do
		4112	color := rgbRed + rgbGreen + rgbBlue;
		4113	Inc(PByte(S));
		4114	PByte(D)^ := color;
		4115	Inc(PByte(D));
		4116	end;
		4117	4:
		4118	begin
		4119	with Temp1.ColorTable[PByte(S)^] do
		4120	color := rgbRed + rgbGreen + rgbBlue;
		4121	Inc(PByte(S));
		4122	P := @PArrayByte(D)[X shr 1];
		4123	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4124	end;
		4125	else
		4126	end;
		4127	end;
		4128	end;
		4129	case BitCount of
		4130	8, 4: Temp1.Free;
		4131	else
		4132	end;
		4133	end;
1	daniel-mar	4134
4	daniel-mar	4135	procedure TDIB.Lightness(Amount: Integer);
		4136	var
		4137	x, y: Integer;
		4138	Table1: array[0..255] of Byte;
		4139	i: Byte;
		4140	S, D: pointer;
		4141	Temp1: TDIB;
		4142	color: DWORD;
		4143	P: PByte;
		4144	R, G, B: Byte;
		4145	begin
		4146	D := nil;
		4147	S := nil;
		4148	Temp1 := nil;
		4149	if Amount < 0 then
		4150	begin
		4151	Amount := -Amount;
		4152	for i := 0 to 255 do
		4153	Table1[i] := IntToByte(i - ((Amount * i) shr 8));
		4154	end
		4155	else
		4156	for i := 0 to 255 do
		4157	Table1[i] := IntToByte(i + ((Amount * (i xor 255)) shr 8));
		4158	case BitCount of
		4159	32: Exit; // I haven't bitmap of this type ! Sorry
		4160	24: ; // nothing to do
		4161	16: ; // I have an artificial bitmap for this type ! i don't sure that it works
		4162	8, 4:
		4163	begin
		4164	Temp1 := TDIB.Create;
		4165	Temp1.Assign(self);
		4166	Temp1.SetSize(Width, Height, BitCount);
		4167	for i := 0 to 255 do
		4168	begin
		4169	with ColorTable[i] do
		4170	begin
		4171	rgbRed := IntToByte(Table1[rgbRed]);
		4172	rgbGreen := IntToByte(Table1[rgbGreen]);
		4173	rgbBlue := IntToByte(Table1[rgbBlue]);
		4174	end;
1	daniel-mar	4175	end;
4	daniel-mar	4176	UpdatePalette;
1	daniel-mar	4177	end;
4	daniel-mar	4178	else
		4179	// if the number of pixel is equal to 1 then exit of procedure
		4180	Exit;
		4181	end;
		4182	for y := 0 to Pred(Height) do
		4183	begin
		4184	case BitCount of
		4185	24, 16: D := ScanLine[y];
		4186	8, 4:
		4187	begin
		4188	D := Temp1.ScanLine[y];
		4189	S := Temp1.ScanLine[y];
		4190	end;
		4191	else
1	daniel-mar	4192	end;
4	daniel-mar	4193	for x := 0 to Pred(Width) do
		4194	begin
		4195	case BitCount of
		4196	32: ;
		4197	24:
		4198	begin
		4199	PBGR(D)^.B := Table1[PBGR(D)^.B];
		4200	PBGR(D)^.G := Table1[PBGR(D)^.G];
		4201	PBGR(D)^.R := Table1[PBGR(D)^.R];
		4202	Inc(PBGR(D));
		4203	end;
		4204	16:
		4205	begin
		4206	pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
		4207	PWord(D)^ := Table1[R] + Table1[G] + Table1[B];
		4208	Inc(PWord(D));
		4209	end;
		4210	8:
		4211	begin
		4212	with Temp1.ColorTable[PByte(S)^] do
		4213	color := rgbRed + rgbGreen + rgbBlue;
		4214	Inc(PByte(S));
		4215	PByte(D)^ := color;
		4216	Inc(PByte(D));
		4217	end;
		4218	4:
		4219	begin
		4220	with Temp1.ColorTable[PByte(S)^] do
		4221	color := rgbRed + rgbGreen + rgbBlue;
		4222	Inc(PByte(S));
		4223	P := @PArrayByte(D)[X shr 1];
		4224	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4225	end;
		4226	else
		4227	end;
		4228	end;
		4229	end;
		4230	case BitCount of
		4231	8, 4: Temp1.Free;
		4232	else
		4233	end;
		4234	end;
1	daniel-mar	4235
4	daniel-mar	4236	procedure TDIB.AddRGB(aR, aG, aB: Byte);
		4237	var
		4238	Table: array[0..255] of TBGR;
		4239	x, y: Integer;
		4240	i: Byte;
		4241	D: pointer;
		4242	P: PByte;
		4243	color: DWORD;
		4244	Temp1: TDIB;
		4245	R, G, B: Byte;
		4246	begin
		4247	color := 0;
		4248	D := nil;
		4249	Temp1 := nil;
		4250	case BitCount of
		4251	32: Exit; // I haven't bitmap of this type ! Sorry
		4252	24, 16:
1	daniel-mar	4253	begin
4	daniel-mar	4254	for i := 0 to 255 do
		4255	begin
		4256	Table[i].b := IntToByte(i + aB);
		4257	Table[i].g := IntToByte(i + aG);
		4258	Table[i].r := IntToByte(i + aR);
		4259	end;
		4260	end;
		4261	8, 4:
		4262	begin
		4263	Temp1 := TDIB.Create;
		4264	Temp1.Assign(self);
		4265	Temp1.SetSize(Width, Height, BitCount);
		4266	for i := 0 to 255 do
		4267	begin
		4268	with ColorTable[i] do
		4269	begin
		4270	rgbRed := IntToByte(rgbRed + aR);
		4271	rgbGreen := IntToByte(rgbGreen + aG);
		4272	rgbBlue := IntToByte(rgbBlue + aB);
		4273	end;
		4274	end;
		4275	UpdatePalette;
		4276	end;
		4277	else
		4278	// if the number of pixel is equal to 1 then exit of procedure
		4279	Exit;
		4280	end;
		4281	for y := 0 to Pred(Height) do
		4282	begin
		4283	case BitCount of
		4284	24, 16: D := ScanLine[y];
		4285	8, 4:
		4286	begin
		4287	D := Temp1.ScanLine[y];
		4288	end;
		4289	else
		4290	end;
		4291	for x := 0 to Pred(Width) do
		4292	begin
		4293	case BitCount of
		4294	32: ; // I haven't bitmap of this type ! Sorry
		4295	24:
		4296	begin
		4297	PBGR(D)^.B := Table[PBGR(D)^.B].b;
		4298	PBGR(D)^.G := Table[PBGR(D)^.G].g;
		4299	PBGR(D)^.R := Table[PBGR(D)^.R].r;
		4300	Inc(PBGR(D));
		4301	end;
		4302	16:
		4303	begin
		4304	pfGetRGB(NowPixelFormat, PWord(D)^, R, G, B);
		4305	PWord(D)^ := Table[R].r + Table[G].g + Table[B].b;
		4306	Inc(PWord(D));
		4307	end;
		4308	8:
		4309	begin
		4310	Inc(PByte(D));
		4311	end;
		4312	4:
		4313	begin
		4314	P := @PArrayByte(D)[X shr 1];
		4315	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4316	end;
		4317	else
		4318	end;
		4319	end;
		4320	end;
		4321	case BitCount of
		4322	8, 4: Temp1.Free;
		4323	else
		4324	end;
		4325	end;
1	daniel-mar	4326
4	daniel-mar	4327	function TDIB.Filter(Dest: TDIB; Filter: TFilter): Boolean;
		4328	var
		4329	Sum, r, g, b, x, y: Integer;
		4330	a, i, j: byte;
		4331	tmp: TBGR;
		4332	Col: PBGR;
		4333	D: Pointer;
		4334	begin
		4335	Result := True;
		4336	Sum := Filter[0, 0] + Filter[1, 0] + Filter[2, 0] +
		4337	Filter[0, 1] + Filter[1, 1] + Filter[2, 1] +
		4338	Filter[0, 2] + Filter[1, 2] + Filter[2, 2];
		4339	if Sum = 0 then
		4340	Sum := 1;
		4341	Col := PBits;
		4342	for y := 0 to Pred(Height) do
		4343	begin
		4344	D := Dest.ScanLine[y];
		4345	for x := 0 to Pred(Width) do
		4346	begin
		4347	r := 0; g := 0; b := 0;
		4348	case BitCount of
		4349	32, 16, 4, 1:
		4350	begin
		4351	Result := False;
		4352	Exit;
		4353	end;
		4354	24:
		4355	begin
		4356	for i := 0 to 2 do
		4357	begin
		4358	for j := 0 to 2 do
		4359	begin
		4360	Tmp := IntToColor(Pixels[Interval(0, Pred(Width), x + Pred(i), True),
		4361	Interval(0, Pred(Height), y + Pred(j), True)]);
		4362	Inc(b, Filter[i, j] * Tmp.b);
		4363	Inc(g, Filter[i, j] * Tmp.g);
		4364	Inc(r, Filter[i, j] * Tmp.r);
1	daniel-mar	4365	end;
4	daniel-mar	4366	end;
		4367	Col.b := IntToByte(b div Sum);
		4368	Col.g := IntToByte(g div Sum);
		4369	Col.r := IntToByte(r div Sum);
		4370	Dest.Pixels[x, y] := rgb(Col.r, Col.g, Col.b);
		4371	end;
		4372	8:
		4373	begin
		4374	for i := 0 to 2 do
		4375	begin
		4376	for j := 0 to 2 do
		4377	begin
		4378	a := (Pixels[Interval(0, Pred(Width), x + Pred(i), True),
		4379	Interval(0, Pred(Height), y + Pred(j), True)]);
		4380	tmp.r := ColorTable[a].rgbRed;
		4381	tmp.g := ColorTable[a].rgbGreen;
		4382	tmp.b := ColorTable[a].rgbBlue;
		4383	Inc(b, Filter[i, j] * Tmp.b);
		4384	Inc(g, Filter[i, j] * Tmp.g);
		4385	Inc(r, Filter[i, j] * Tmp.r);
1	daniel-mar	4386	end;
4	daniel-mar	4387	end;
		4388	Col.b := IntToByte(b div Sum);
		4389	Col.g := IntToByte(g div Sum);
		4390	Col.r := IntToByte(r div Sum);
		4391	PByte(D)^ := rgb(Col.r, Col.g, Col.b);
		4392	Inc(PByte(D));
		4393	end;
		4394	end;
		4395	end;
		4396	end;
		4397	end;
1	daniel-mar	4398
4	daniel-mar	4399	procedure TDIB.Spray(Amount: Integer);
		4400	var
		4401	value, x, y: Integer;
		4402	D: Pointer;
		4403	color: DWORD;
		4404	P: PByte;
		4405	begin
		4406	for y := Pred(Height) downto 0 do
		4407	begin
		4408	D := ScanLine[y];
		4409	for x := 0 to Pred(Width) do
		4410	begin
		4411	value := Random(Amount);
		4412	color := Pixels[Interval(0, Pred(Width), x + (value - Random(value * 2)), True),
		4413	Interval(0, Pred(Height), y + (value - Random(value * 2)), True)];
		4414	case BitCount of
		4415	32:
		4416	begin
		4417	PDWord(D)^ := color;
		4418	Inc(PDWord(D));
		4419	end;
		4420	24:
		4421	begin
		4422	PBGR(D)^ := IntToColor(color);
		4423	Inc(PBGR(D));
		4424	end;
		4425	16:
		4426	begin
		4427	PWord(D)^ := color;
		4428	Inc(PWord(D));
		4429	end;
		4430	8:
		4431	begin
		4432	PByte(D)^ := color;
		4433	Inc(PByte(D));
		4434	end;
		4435	4:
		4436	begin
		4437	P := @PArrayByte(D)[X shr 1];
		4438	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4439	end;
		4440	1:
		4441	begin
		4442	P := @PArrayByte(D)[X shr 3];
		4443	P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
		4444	end;
		4445	else
1	daniel-mar	4446	end;
		4447	end;
4	daniel-mar	4448	end;
		4449	end;
		4450
		4451	procedure TDIB.Sharpen(Amount: Integer);
		4452	var
		4453	Lin0, Lin1, Lin2: PLines;
		4454	pc: PBGR;
		4455	cx, x, y: Integer;
		4456	Buf: array[0..8] of TBGR;
		4457	D: pointer;
		4458	c: DWORD;
		4459	i: byte;
		4460	P1: PByte;
		4461	Temp1: TDIB;
		4462
		4463	begin
		4464	D := nil;
		4465	GetMem(pc, SizeOf(TBGR));
		4466	c := 0;
		4467	Temp1 := nil;
		4468	case Bitcount of
		4469	32, 16, 1: Exit;
		4470	24:
		4471	begin
		4472	Temp1 := TDIB.Create;
		4473	Temp1.Assign(self);
		4474	Temp1.SetSize(Width, Height, bitCount);
		4475	end;
		4476	8:
		4477	begin
		4478	Temp1 := TDIB.Create;
		4479	Temp1.Assign(self);
		4480	Temp1.SetSize(Width, Height, bitCount);
		4481	for i := 0 to 255 do
		4482	begin
		4483	with Temp1.ColorTable[i] do
		4484	begin
		4485	Buf[0].B := ColorTable[i - Amount].rgbBlue;
		4486	Buf[0].G := ColorTable[i - Amount].rgbGreen;
		4487	Buf[0].R := ColorTable[i - Amount].rgbRed;
		4488	Buf[1].B := ColorTable[i].rgbBlue;
		4489	Buf[1].G := ColorTable[i].rgbGreen;
		4490	Buf[1].R := ColorTable[i].rgbRed;
		4491	Buf[2].B := ColorTable[i + Amount].rgbBlue;
		4492	Buf[2].G := ColorTable[i + Amount].rgbGreen;
		4493	Buf[2].R := ColorTable[i + Amount].rgbRed;
		4494	Buf[3].B := ColorTable[i - Amount].rgbBlue;
		4495	Buf[3].G := ColorTable[i - Amount].rgbGreen;
		4496	Buf[3].R := ColorTable[i - Amount].rgbRed;
		4497	Buf[4].B := ColorTable[i].rgbBlue;
		4498	Buf[4].G := ColorTable[i].rgbGreen;
		4499	Buf[4].R := ColorTable[i].rgbRed;
		4500	Buf[5].B := ColorTable[i + Amount].rgbBlue;
		4501	Buf[5].G := ColorTable[i + Amount].rgbGreen;
		4502	Buf[5].R := ColorTable[i + Amount].rgbRed;
		4503	Buf[6].B := ColorTable[i - Amount].rgbBlue;
		4504	Buf[6].G := ColorTable[i - Amount].rgbGreen;
		4505	Buf[6].R := ColorTable[i - Amount].rgbRed;
		4506	Buf[7].B := ColorTable[i].rgbBlue;
		4507	Buf[7].G := ColorTable[i].rgbGreen;
		4508	Buf[7].R := ColorTable[i].rgbRed;
		4509	Buf[8].B := ColorTable[i + Amount].rgbBlue;
		4510	Buf[8].G := ColorTable[i + Amount].rgbGreen;
		4511	Buf[8].R := ColorTable[i + Amount].rgbRed;
		4512	Temp1.colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
		4513	Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
		4514	Temp1.colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
		4515	Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
		4516	Temp1.colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
		4517	Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
		4518
		4519	end;
		4520	end;
		4521	Temp1.UpdatePalette;
		4522	end;
		4523	4:
		4524	begin
		4525	Temp1 := TDIB.Create;
		4526	Temp1.Assign(self);
		4527	Temp1.SetSize(Width, Height, bitCount);
		4528	for i := 0 to 255 do
		4529	begin
		4530	with Temp1.ColorTable[i] do
		4531	begin
		4532	Buf[0].B := ColorTable[i - Amount].rgbBlue;
		4533	Buf[0].G := ColorTable[i - Amount].rgbGreen;
		4534	Buf[0].R := ColorTable[i - Amount].rgbRed;
		4535	Buf[1].B := ColorTable[i].rgbBlue;
		4536	Buf[1].G := ColorTable[i].rgbGreen;
		4537	Buf[1].R := ColorTable[i].rgbRed;
		4538	Buf[2].B := ColorTable[i + Amount].rgbBlue;
		4539	Buf[2].G := ColorTable[i + Amount].rgbGreen;
		4540	Buf[2].R := ColorTable[i + Amount].rgbRed;
		4541	Buf[3].B := ColorTable[i - Amount].rgbBlue;
		4542	Buf[3].G := ColorTable[i - Amount].rgbGreen;
		4543	Buf[3].R := ColorTable[i - Amount].rgbRed;
		4544	Buf[4].B := ColorTable[i].rgbBlue;
		4545	Buf[4].G := ColorTable[i].rgbGreen;
		4546	Buf[4].R := ColorTable[i].rgbRed;
		4547	Buf[5].B := ColorTable[i + Amount].rgbBlue;
		4548	Buf[5].G := ColorTable[i + Amount].rgbGreen;
		4549	Buf[5].R := ColorTable[i + Amount].rgbRed;
		4550	Buf[6].B := ColorTable[i - Amount].rgbBlue;
		4551	Buf[6].G := ColorTable[i - Amount].rgbGreen;
		4552	Buf[6].R := ColorTable[i - Amount].rgbRed;
		4553	Buf[7].B := ColorTable[i].rgbBlue;
		4554	Buf[7].G := ColorTable[i].rgbGreen;
		4555	Buf[7].R := ColorTable[i].rgbRed;
		4556	Buf[8].B := ColorTable[i + Amount].rgbBlue;
		4557	Buf[8].G := ColorTable[i + Amount].rgbGreen;
		4558	Buf[8].R := ColorTable[i + Amount].rgbRed;
		4559	colorTable[i].rgbBlue := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
		4560	Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
		4561	colorTable[i].rgbGreen := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
		4562	Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
		4563	colorTable[i].rgbRed := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
		4564	Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
		4565	end;
		4566	end;
		4567	UpdatePalette;
		4568	end;
		4569	end;
		4570	for y := 0 to Pred(Height) do
1	daniel-mar	4571	begin
4	daniel-mar	4572	Lin0 := ScanLine[Interval(0, Pred(Height), y - Amount, True)];
		4573	Lin1 := ScanLine[y];
		4574	Lin2 := ScanLine[Interval(0, Pred(Height), y + Amount, True)];
		4575	case Bitcount of
		4576	24, 8, 4: D := Temp1.ScanLine[y];
		4577	end;
		4578	for x := 0 to Pred(Width) do
		4579	begin
		4580	case BitCount of
		4581	24:
		4582	begin
		4583	cx := Interval(0, Pred(Width), x - Amount, True);
		4584	Buf[0] := Lin0[cx];
		4585	Buf[1] := Lin1[cx];
		4586	Buf[2] := Lin2[cx];
		4587	Buf[3] := Lin0[x];
		4588	Buf[4] := Lin1[x];
		4589	Buf[5] := Lin2[x];
		4590	cx := Interval(0, Pred(Width), x + Amount, true);
		4591	Buf[6] := Lin0[cx];
		4592	Buf[7] := Lin1[cx];
		4593	Buf[8] := Lin0[cx];
		4594	pc.b := IntToByte((256 * Buf[4].b - (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b +
		4595	Buf[5].b + Buf[6].b + Buf[7].b + Buf[8].b) * 16) div 128);
		4596	pc.g := IntToByte((256 * Buf[4].g - (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g +
		4597	Buf[5].g + Buf[6].g + Buf[7].g + Buf[8].g) * 16) div 128);
		4598	pc.r := IntToByte((256 * Buf[4].r - (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r +
		4599	Buf[5].r + Buf[6].r + Buf[7].r + Buf[8].r) * 16) div 128);
		4600	PBGR(D)^.B := pc.b;
		4601	PBGR(D)^.G := pc.g;
		4602	PBGR(D)^.R := pc.r;
		4603	Inc(PBGR(D));
		4604	end;
		4605	8:
		4606	begin
		4607	Inc(PByte(D));
		4608	end;
		4609	4:
		4610	begin
		4611	P1 := @PArrayByte(D)[X shr 1];
		4612	P1^ := ((P1^ and Mask4n[X and 1]) or ((c shl Shift4[X and 1])));
		4613	end;
		4614	end;
		4615	end;
		4616	end;
		4617	case BitCount of
		4618	24, 8:
1	daniel-mar	4619	begin
4	daniel-mar	4620	Assign(Temp1);
		4621	Temp1.Free;
		4622	end;
		4623	4: Temp1.Free;
		4624	end;
		4625	FreeMem(pc, SizeOf(TBGR));
		4626	end;
1	daniel-mar	4627
4	daniel-mar	4628	procedure TDIB.Emboss;
		4629	var
		4630	x, y: longint;
		4631	D, D1, P: pointer;
		4632	color: TBGR;
		4633	c: DWORD;
		4634	P1: PByte;
		4635
		4636	begin
		4637	D := nil;
		4638	D1 := nil;
		4639	P := nil;
		4640	case BitCount of
		4641	32, 16, 1: Exit;
		4642	24:
		4643	begin
		4644	D := PBits;
		4645	D1 := Ptr(Integer(D) + 3);
		4646	end;
		4647	else
		4648	end;
		4649	for y := 0 to Pred(Height) do
		4650	begin
		4651	case Bitcount of
		4652	8, 4:
		4653	begin
		4654	P := ScanLine[y];
1	daniel-mar	4655	end;
4	daniel-mar	4656	end;
		4657	for x := 0 to Pred(Width) do
		4658	begin
		4659	case BitCount of
		4660	24:
		4661	begin
		4662	PBGR(D)^.B := ((PBGR(D)^.B + (PBGR(D1)^.B xor $FF)) shr 1);
		4663	PBGR(D)^.G := ((PBGR(D)^.G + (PBGR(D1)^.G xor $FF)) shr 1);
		4664	PBGR(D)^.R := ((PBGR(D)^.R + (PBGR(D1)^.R xor $FF)) shr 1);
		4665	Inc(PBGR(D));
		4666	if (y < Height - 2) and (x < Width - 2) then
		4667	Inc(PBGR(D1));
		4668	end;
		4669	8:
		4670	begin
		4671	color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
		4672	color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
		4673	color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF)) shr 1) + 30) div 3;
		4674	c := (color.R + color.G + color.B) shr 1;
		4675	PByte(P)^ := c;
		4676	Inc(PByte(P));
		4677	end;
		4678	4:
		4679	begin
		4680	color.R := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
		4681	color.G := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) - 1) shr 1) + 30) div 3;
		4682	color.B := (((Pixels[x, y] + (Pixels[x + 3, y] xor $FF) + 1) shr 1) + 30) div 3;
		4683	c := (color.R + color.G + color.B) shr 1;
		4684	if c > 64 then
		4685	c := c - 8;
		4686	P1 := @PArrayByte(P)[X shr 1];
		4687	P1^ := (P1^ and Mask4n[X and 1]) or ((c) shl Shift4[X and 1]);
		4688	end;
		4689	else
		4690	end;
		4691	end;
		4692	case BitCount of
		4693	24:
		4694	begin
		4695	D := Ptr(Integer(D1));
		4696	if y < Height - 2 then
		4697	D1 := Ptr(Integer(D1) + 6)
		4698	else
		4699	D1 := Ptr(Integer(ScanLine[Pred(Height)]) + 3);
		4700	end;
		4701	else
		4702	end;
		4703	end;
		4704	end;
1	daniel-mar	4705
4	daniel-mar	4706	procedure TDIB.AddMonoNoise(Amount: Integer);
		4707	var
		4708	value: cardinal;
		4709	x, y: longint;
		4710	a: byte;
		4711	D: pointer;
		4712	color: DWORD;
		4713	P: PByte;
		4714	begin
		4715	for y := 0 to Pred(Height) do
		4716	begin
		4717	D := ScanLine[y];
		4718	for x := 0 to Pred(Width) do
		4719	begin
		4720	case BitCount of
		4721	32: Exit; // I haven't bitmap of this type ! Sorry
		4722	24:
		4723	begin
		4724	value := Random(Amount) - (Amount shr 1);
		4725	PBGR(D)^.B := IntToByte(PBGR(D)^.B + value);
		4726	PBGR(D)^.G := IntToByte(PBGR(D)^.G + value);
		4727	PBGR(D)^.R := IntToByte(PBGR(D)^.R + value);
		4728	Inc(PBGR(D));
		4729	end;
		4730	16: Exit; // I haven't bitmap of this type ! Sorry
		4731	8:
		4732	begin
		4733	a := ((Random(Amount shr 1) - (Amount div 4))) div 8;
		4734	color := Interval(0, 255, (pixels[x, y] - a), True);
		4735	PByte(D)^ := color;
		4736	Inc(PByte(D));
		4737	end;
		4738	4:
		4739	begin
		4740	a := ((Random(Amount shr 1) - (Amount div 4))) div 16;
		4741	color := Interval(0, 15, (pixels[x, y] - a), True);
		4742	P := @PArrayByte(D)[X shr 1];
		4743	P^ := ((P^ and Mask4n[X and 1]) or ((color shl Shift4[X and 1])));
		4744	end;
		4745	1:
		4746	begin
		4747	a := ((Random(Amount shr 1) - (Amount div 4))) div 32;
		4748	color := Interval(0, 1, (pixels[x, y] - a), True);
		4749	P := @PArrayByte(D)[X shr 3];
		4750	P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
		4751	end;
		4752	else
1	daniel-mar	4753	end;
		4754	end;
		4755	end;
		4756	end;
		4757
4	daniel-mar	4758	procedure TDIB.AddGradiantNoise(Amount: byte);
1	daniel-mar	4759	var
4	daniel-mar	4760	a, i: byte;
		4761	x, y: Integer;
		4762	Table: array[0..255] of TBGR;
		4763	S, D: pointer;
		4764	color: DWORD;
		4765	Temp1: TDIB;
		4766	P: PByte;
		4767
1	daniel-mar	4768	begin
4	daniel-mar	4769	D := nil;
		4770	S := nil;
		4771	Temp1 := nil;
		4772	case BitCount of
		4773	32: Exit; // I haven't bitmap of this type ! Sorry
		4774	24:
		4775	begin
		4776	for i := 0 to 255 do
		4777	begin
		4778	a := Random(Amount);
		4779	Table[i].b := IntToByte(i + a);
		4780	Table[i].g := IntToByte(i + a);
		4781	Table[i].r := IntToByte(i + a);
		4782	end;
		4783	end;
		4784	16: Exit; // I haven't bitmap of this type ! Sorry
		4785	8, 4:
		4786	begin
		4787	Temp1 := TDIB.Create;
		4788	Temp1.Assign(self);
		4789	Temp1.SetSize(Width, Height, BitCount);
		4790	for i := 0 to 255 do
		4791	begin
		4792	with ColorTable[i] do
		4793	begin
		4794	a := Random(Amount);
		4795	rgbRed := IntToByte(rgbRed + a);
		4796	rgbGreen := IntToByte(rgbGreen + a);
		4797	rgbBlue := IntToByte(rgbBlue + a);
		4798	end;
		4799	end;
		4800	UpdatePalette;
		4801	end;
		4802	else
		4803	// if the number of pixel is equal to 1 then exit of procedure
		4804	Exit;
		4805	end;
		4806	for y := 0 to Pred(Height) do
		4807	begin
		4808	case BitCount of
		4809	24: D := ScanLine[y];
		4810	8, 4:
		4811	begin
		4812	D := Temp1.ScanLine[y];
		4813	S := Temp1.ScanLine[y];
		4814	end;
		4815	else
		4816	end;
		4817	for x := 0 to Pred(Width) do
		4818	begin
		4819	case BitCount of
		4820	32: ; // I haven't bitmap of this type ! Sorry
		4821	24:
		4822	begin
		4823	PBGR(D)^.B := Table[PBGR(D)^.B].b;
		4824	PBGR(D)^.G := Table[PBGR(D)^.G].g;
		4825	PBGR(D)^.R := Table[PBGR(D)^.R].r;
		4826	Inc(PBGR(D));
		4827	end;
		4828	16: ; // I haven't bitmap of this type ! Sorry
		4829	8:
		4830	begin
		4831	with Temp1.ColorTable[PByte(S)^] do
		4832	color := rgbRed + rgbGreen + rgbBlue;
		4833	Inc(PByte(S));
		4834	PByte(D)^ := color;
		4835	Inc(PByte(D));
		4836	end;
		4837	4:
		4838	begin
		4839	with Temp1.ColorTable[PByte(S)^] do
		4840	color := rgbRed + rgbGreen + rgbBlue;
		4841	Inc(PByte(S));
		4842	P := @PArrayByte(D)[X shr 1];
		4843	P^ := (P^ and Mask4n[X and 1]) or (color shl Shift4[X and 1]);
		4844	end;
		4845	else
		4846	end;
		4847	end;
		4848	end;
		4849	case BitCount of
		4850	8, 4: Temp1.Free;
		4851	else
		4852	end;
		4853	end;
1	daniel-mar	4854
4	daniel-mar	4855	function TDIB.FishEye(bmp: TDIB): Boolean;
		4856	var
		4857	weight, xmid, ymid, fx, fy, r1, r2, dx, dy, rmax: Double;
		4858	Amount, ifx, ify, ty, tx, new_red, new_green, new_blue, ix, iy: Integer;
		4859	weight_x, weight_y: array[0..1] of Double;
		4860	total_red, total_green, total_blue: Double;
		4861	sli, slo: PLines;
16	daniel-mar	4862	//D: Pointer;
4	daniel-mar	4863	begin
		4864	Result := True;
		4865	case BitCount of
		4866	32, 16, 8, 4, 1:
		4867	begin
		4868	Result := False;
		4869	Exit;
		4870	end;
		4871	end;
		4872	Amount := 1;
		4873	xmid := Width / 2;
		4874	ymid := Height / 2;
		4875	rmax := Max(Bmp.Width, Bmp.Height) * Amount;
		4876	for ty := 0 to Pred(Height) do
1	daniel-mar	4877	begin
4	daniel-mar	4878	for tx := 0 to Pred(Width) do
		4879	begin
		4880	dx := tx - xmid;
		4881	dy := ty - ymid;
		4882	r1 := Sqrt(Sqr(dx) + Sqr(dy));
		4883	if r1 <> 0 then
1	daniel-mar	4884	begin
4	daniel-mar	4885	r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
		4886	fx := dx * r2 / r1 + xmid;
		4887	fy := dy * r2 / r1 + ymid;
		4888	end
		4889	else
		4890	begin
		4891	fx := xmid;
		4892	fy := ymid;
1	daniel-mar	4893	end;
4	daniel-mar	4894	ify := Trunc(fy);
		4895	ifx := Trunc(fx);
		4896	if fy >= 0 then
		4897	begin
		4898	weight_y[1] := fy - ify;
		4899	weight_y[0] := 1 - weight_y[1];
		4900	end
		4901	else
		4902	begin
		4903	weight_y[0] := -(fy - ify);
		4904	weight_y[1] := 1 - weight_y[0];
		4905	end;
		4906	if fx >= 0 then
		4907	begin
		4908	weight_x[1] := fx - ifx;
		4909	weight_x[0] := 1 - weight_x[1];
		4910	end
		4911	else
		4912	begin
		4913	weight_x[0] := -(fx - ifx);
		4914	Weight_x[1] := 1 - weight_x[0];
		4915	end;
		4916	if ifx < 0 then
		4917	ifx := Pred(Width) - (-ifx mod Width)
		4918	else
		4919	if ifx > Pred(Width) then
		4920	ifx := ifx mod Width;
		4921	if ify < 0 then
		4922	ify := Pred(Height) - (-ify mod Height)
		4923	else
		4924	if ify > Pred(Height) then
		4925	ify := ify mod Height;
		4926	total_red := 0.0;
		4927	total_green := 0.0;
		4928	total_blue := 0.0;
		4929	for ix := 0 to 1 do
		4930	begin
		4931	for iy := 0 to 1 do
		4932	begin
		4933	if ify + iy < Height then
		4934	sli := ScanLine[ify + iy]
		4935	else
		4936	sli := ScanLine[Height - ify - iy];
		4937	if ifx + ix < Width then
		4938	begin
		4939	new_red := sli^[ifx + ix].r;
		4940	new_green := sli^[ifx + ix].g;
		4941	new_blue := sli^[ifx + ix].b;
		4942	end
		4943	else
		4944	begin
		4945	new_red := sli^[Width - ifx - ix].r;
		4946	new_green := sli^[Width - ifx - ix].g;
		4947	new_blue := sli^[Width - ifx - ix].b;
		4948	end;
		4949	weight := weight_x[ix] * weight_y[iy];
		4950	total_red := total_red + new_red * weight;
		4951	total_green := total_green + new_green * weight;
		4952	total_blue := total_blue + new_blue * weight;
		4953	end;
		4954	end;
		4955	case bitCount of
		4956	24:
		4957	begin
		4958	slo := Bmp.ScanLine[ty];
		4959	slo^[tx].r := Round(total_red);
		4960	slo^[tx].g := Round(total_green);
		4961	slo^[tx].b := Round(total_blue);
		4962	end;
		4963	else
		4964	// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
		4965	Exit;
		4966	end;
		4967	end;
		4968	end;
		4969	end;
		4970
		4971	function TDIB.SmoothRotateWrap(Bmp: TDIB; cx, cy: Integer; Degree: Extended): Boolean;
		4972	var
		4973	weight, Theta, cosTheta, sinTheta, sfrom_y, sfrom_x: Double;
		4974	ifrom_y, ifrom_x, xDiff, yDiff, to_y, to_x: Integer;
		4975	weight_x, weight_y: array[0..1] of Double;
		4976	ix, iy, new_red, new_green, new_blue: Integer;
		4977	total_red, total_green, total_blue: Double;
		4978	sli, slo: PLines;
		4979	begin
		4980	Result := True;
		4981	case BitCount of
		4982	32, 16, 8, 4, 1:
		4983	begin
		4984	Result := False;
		4985	Exit;
		4986	end;
		4987	end;
		4988	Theta := -Degree * Pi / 180;
		4989	sinTheta := Sin(Theta);
		4990	cosTheta := Cos(Theta);
		4991	xDiff := (Bmp.Width - Width) div 2;
		4992	yDiff := (Bmp.Height - Height) div 2;
		4993	for to_y := 0 to Pred(Bmp.Height) do
1	daniel-mar	4994	begin
4	daniel-mar	4995	for to_x := 0 to Pred(Bmp.Width) do
		4996	begin
		4997	sfrom_x := (cx + (to_x - cx) * cosTheta - (to_y - cy) * sinTheta) - xDiff;
		4998	ifrom_x := Trunc(sfrom_x);
		4999	sfrom_y := (cy + (to_x - cx) * sinTheta + (to_y - cy) * cosTheta) - yDiff;
		5000	ifrom_y := Trunc(sfrom_y);
		5001	if sfrom_y >= 0 then
		5002	begin
		5003	weight_y[1] := sfrom_y - ifrom_y;
		5004	weight_y[0] := 1 - weight_y[1];
		5005	end
		5006	else
		5007	begin
		5008	weight_y[0] := -(sfrom_y - ifrom_y);
		5009	weight_y[1] := 1 - weight_y[0];
		5010	end;
		5011	if sfrom_x >= 0 then
		5012	begin
		5013	weight_x[1] := sfrom_x - ifrom_x;
		5014	weight_x[0] := 1 - weight_x[1];
		5015	end
		5016	else
		5017	begin
		5018	weight_x[0] := -(sfrom_x - ifrom_x);
		5019	Weight_x[1] := 1 - weight_x[0];
		5020	end;
		5021	if ifrom_x < 0 then
		5022	ifrom_x := Pred(Width) - (-ifrom_x mod Width)
		5023	else
		5024	if ifrom_x > Pred(Width) then
		5025	ifrom_x := ifrom_x mod Width;
		5026	if ifrom_y < 0 then
		5027	ifrom_y := Pred(Height) - (-ifrom_y mod Height)
		5028	else
		5029	if ifrom_y > Pred(Height) then
		5030	ifrom_y := ifrom_y mod Height;
		5031	total_red := 0.0;
		5032	total_green := 0.0;
		5033	total_blue := 0.0;
		5034	for ix := 0 to 1 do
		5035	begin
		5036	for iy := 0 to 1 do
		5037	begin
		5038	if ifrom_y + iy < Height then
		5039	sli := ScanLine[ifrom_y + iy]
		5040	else
		5041	sli := ScanLine[Height - ifrom_y - iy];
		5042	if ifrom_x + ix < Width then
		5043	begin
		5044	new_red := sli^[ifrom_x + ix].r;
		5045	new_green := sli^[ifrom_x + ix].g;
		5046	new_blue := sli^[ifrom_x + ix].b;
		5047	end
		5048	else
		5049	begin
		5050	new_red := sli^[Width - ifrom_x - ix].r;
		5051	new_green := sli^[Width - ifrom_x - ix].g;
		5052	new_blue := sli^[Width - ifrom_x - ix].b;
		5053	end;
		5054	weight := weight_x[ix] * weight_y[iy];
		5055	total_red := total_red + new_red * weight;
		5056	total_green := total_green + new_green * weight;
		5057	total_blue := total_blue + new_blue * weight;
		5058	end;
		5059	end;
		5060	case bitCount of
		5061	24:
		5062	begin
		5063	slo := Bmp.ScanLine[to_y];
		5064	slo^[to_x].r := Round(total_red);
		5065	slo^[to_x].g := Round(total_green);
		5066	slo^[to_x].b := Round(total_blue);
		5067	end;
		5068	else
		5069	// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
		5070	Exit;
		5071	end;
		5072	end;
		5073	end;
		5074	end;
1	daniel-mar	5075
4	daniel-mar	5076	function TDIB.Rotate(Dst: TDIB; cx, cy: Integer; Angle: Double): Boolean;
		5077	var
		5078	x, y, dx, dy, sdx, sdy, xDiff, yDiff, isinTheta, icosTheta: Integer;
		5079	D, S: Pointer;
		5080	sinTheta, cosTheta, Theta: Double;
		5081	Col: TBGR;
		5082	i: byte;
		5083	color: DWORD;
		5084	P: PByte;
		5085	begin
		5086	D := nil;
		5087	S := nil;
		5088	Result := True;
		5089	dst.SetSize(Width, Height, Bitcount);
		5090	dst.Canvas.Brush.Color := clBlack;
		5091	Dst.Canvas.FillRect(Bounds(0, 0, Width, Height));
		5092	case BitCount of
		5093	32, 16:
		5094	begin
		5095	Result := False;
		5096	Exit;
		5097	end;
		5098	8, 4, 1:
		5099	begin
		5100	for i := 0 to 255 do
		5101	Dst.ColorTable[i] := ColorTable[i];
		5102	Dst.UpdatePalette;
		5103	end;
		5104	end;
		5105	Theta := -Angle * Pi / 180;
		5106	sinTheta := Sin(Theta);
		5107	cosTheta := Cos(Theta);
		5108	xDiff := (Dst.Width - Width) div 2;
		5109	yDiff := (Dst.Height - Height) div 2;
		5110	isinTheta := Round(sinTheta * $10000);
		5111	icosTheta := Round(cosTheta * $10000);
		5112	for y := 0 to Pred(Dst.Height) do
		5113	begin
		5114	case BitCount of
		5115	4, 1:
		5116	begin
		5117	D := Dst.ScanLine[y];
		5118	S := ScanLine[y];
		5119	end;
		5120	else
		5121	end;
		5122	sdx := Round(((cx + (-cx) * cosTheta - (y - cy) * sinTheta) - xDiff) * $10000);
		5123	sdy := Round(((cy + (-cy) * sinTheta + (y - cy) * cosTheta) - yDiff) * $10000);
		5124	for x := 0 to Pred(Dst.Width) do
		5125	begin
		5126	dx := (sdx shr 16);
		5127	dy := (sdy shr 16);
		5128	if (dx > -1) and (dx < Width) and (dy > -1) and (dy < Height) then
		5129	begin
		5130	case bitcount of
		5131	8, 24: Dst.pixels[x, y] := Pixels[dx, dy];
		5132	4:
		5133	begin
		5134	pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
		5135	color := col.r + col.g + col.b;
		5136	Inc(PByte(S));
		5137	P := @PArrayByte(D)[x shr 1];
		5138	P^ := (P^ and Mask4n[x and 1]) or (color shl Shift4[x and 1]);
		5139	end;
		5140	1:
		5141	begin
		5142	pfGetRGB(NowPixelFormat, Pixels[dx, dy], col.r, col.g, col.b);
		5143	color := col.r + col.g + col.b;
		5144	Inc(PByte(S));
		5145	P := @PArrayByte(D)[X shr 3];
		5146	P^ := (P^ and Mask1n[X and 7]) or (color shl Shift1[X and 7]);
		5147	end;
		5148	end;
		5149	end;
		5150	Inc(sdx, icosTheta);
		5151	Inc(sdy, isinTheta);
		5152	end;
		5153	end;
		5154	end;
1	daniel-mar	5155
4	daniel-mar	5156	procedure TDIB.GaussianBlur(Bmp: TDIB; Amount: Integer);
		5157	var
		5158	i: Integer;
		5159	begin
		5160	for i := 1 to Amount do
		5161	Bmp.SplitBlur(i);
		5162	end;
1	daniel-mar	5163
4	daniel-mar	5164	procedure TDIB.SplitBlur(Amount: Integer);
		5165	var
		5166	Lin1, Lin2: PLines;
		5167	cx, x, y: Integer;
		5168	Buf: array[0..3] of TBGR;
		5169	D: Pointer;
1	daniel-mar	5170
4	daniel-mar	5171	begin
		5172	case Bitcount of
		5173	32, 16, 8, 4, 1: Exit;
		5174	end;
		5175	for y := 0 to Pred(Height) do
		5176	begin
		5177	Lin1 := ScanLine[TrimInt(y + Amount, 0, Pred(Height))];
		5178	Lin2 := ScanLine[TrimInt(y - Amount, 0, Pred(Height))];
		5179	D := ScanLine[y];
		5180	for x := 0 to Pred(Width) do
		5181	begin
		5182	cx := TrimInt(x + Amount, 0, Pred(Width));
		5183	Buf[0] := Lin1[cx];
		5184	Buf[1] := Lin2[cx];
		5185	cx := TrimInt(x - Amount, 0, Pred(Width));
		5186	Buf[2] := Lin1[cx];
		5187	Buf[3] := Lin2[cx];
		5188	PBGR(D)^.b := (Buf[0].b + Buf[1].b + Buf[2].b + Buf[3].b) shr 2;
		5189	PBGR(D)^.g := (Buf[0].g + Buf[1].g + Buf[2].g + Buf[3].g) shr 2;
		5190	PBGR(D)^.r := (Buf[0].r + Buf[1].r + Buf[2].r + Buf[3].r) shr 2;
		5191	Inc(PBGR(D));
		5192	end;
		5193	end;
		5194	end;
1	daniel-mar	5195
4	daniel-mar	5196	function TDIB.Twist(bmp: TDIB; Amount: byte): Boolean;
		5197	var
		5198	fxmid, fymid: Single;
		5199	txmid, tymid: Single;
		5200	fx, fy: Single;
		5201	tx2, ty2: Single;
		5202	r: Single;
		5203	theta: Single;
		5204	ifx, ify: Integer;
		5205	dx, dy: Single;
		5206	OFFSET: Single;
		5207	ty, tx, ix, iy: Integer;
		5208	weight_x, weight_y: array[0..1] of Single;
		5209	weight: Single;
		5210	new_red, new_green, new_blue: Integer;
		5211	total_red, total_green, total_blue: Single;
		5212	sli, slo: PLines;
1	daniel-mar	5213
4	daniel-mar	5214	function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
		5215	begin
		5216	if xt = 0 then
		5217	if yt > 0 then
		5218	Result := Pi / 2
		5219	else
		5220	Result := -(Pi / 2)
		5221	else
		5222	begin
		5223	Result := ArcTan(yt / xt);
		5224	if xt < 0 then
		5225	Result := Pi + ArcTan(yt / xt);
1	daniel-mar	5226	end;
		5227	end;
4	daniel-mar	5228
		5229	begin
		5230	Result := True;
		5231	case BitCount of
		5232	32, 16, 8, 4, 1:
		5233	begin
		5234	Result := False;
		5235	Exit;
		5236	end;
		5237	end;
		5238	if Amount = 0 then
		5239	Amount := 1;
		5240	OFFSET := -(Pi / 2);
		5241	dx := Pred(Width);
		5242	dy := Pred(Height);
		5243	r := Sqrt(dx * dx + dy * dy);
		5244	tx2 := r;
		5245	ty2 := r;
		5246	txmid := (Pred(Width)) / 2;
		5247	tymid := (Pred(Height)) / 2;
		5248	fxmid := (Pred(Width)) / 2;
		5249	fymid := (Pred(Height)) / 2;
		5250	if tx2 >= Width then
		5251	tx2 := Pred(Width);
		5252	if ty2 >= Height then
		5253	ty2 := Pred(Height);
		5254	for ty := 0 to Round(ty2) do
		5255	begin
		5256	for tx := 0 to Round(tx2) do
		5257	begin
		5258	dx := tx - txmid;
		5259	dy := ty - tymid;
		5260	r := Sqrt(dx * dx + dy * dy);
		5261	if r = 0 then
		5262	begin
		5263	fx := 0;
		5264	fy := 0;
		5265	end
		5266	else
		5267	begin
		5268	theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
		5269	fx := r * Cos(theta);
		5270	fy := r * Sin(theta);
		5271	end;
		5272	fx := fx + fxmid;
		5273	fy := fy + fymid;
		5274	ify := Trunc(fy);
		5275	ifx := Trunc(fx);
		5276	if fy >= 0 then
		5277	begin
		5278	weight_y[1] := fy - ify;
		5279	weight_y[0] := 1 - weight_y[1];
		5280	end
		5281	else
		5282	begin
		5283	weight_y[0] := -(fy - ify);
		5284	weight_y[1] := 1 - weight_y[0];
		5285	end;
		5286	if fx >= 0 then
		5287	begin
		5288	weight_x[1] := fx - ifx;
		5289	weight_x[0] := 1 - weight_x[1];
		5290	end
		5291	else
		5292	begin
		5293	weight_x[0] := -(fx - ifx);
		5294	Weight_x[1] := 1 - weight_x[0];
		5295	end;
		5296	if ifx < 0 then
		5297	ifx := Pred(Width) - (-ifx mod Width)
		5298	else
		5299	if ifx > Pred(Width) then
		5300	ifx := ifx mod Width;
		5301	if ify < 0 then
		5302	ify := Pred(Height) - (-ify mod Height)
		5303	else
		5304	if ify > Pred(Height) then
		5305	ify := ify mod Height;
		5306	total_red := 0.0;
		5307	total_green := 0.0;
		5308	total_blue := 0.0;
		5309	for ix := 0 to 1 do
		5310	begin
		5311	for iy := 0 to 1 do
		5312	begin
		5313	if ify + iy < Height then
		5314	sli := ScanLine[ify + iy]
		5315	else
		5316	sli := ScanLine[Height - ify - iy];
		5317	if ifx + ix < Width then
		5318	begin
		5319	new_red := sli^[ifx + ix].r;
		5320	new_green := sli^[ifx + ix].g;
		5321	new_blue := sli^[ifx + ix].b;
		5322	end
		5323	else
		5324	begin
		5325	new_red := sli^[Width - ifx - ix].r;
		5326	new_green := sli^[Width - ifx - ix].g;
		5327	new_blue := sli^[Width - ifx - ix].b;
		5328	end;
		5329	weight := weight_x[ix] * weight_y[iy];
		5330	total_red := total_red + new_red * weight;
		5331	total_green := total_green + new_green * weight;
		5332	total_blue := total_blue + new_blue * weight;
		5333	end;
		5334	end;
		5335	case bitCount of
		5336	24:
		5337	begin
		5338	slo := bmp.ScanLine[ty];
		5339	slo^[tx].r := Round(total_red);
		5340	slo^[tx].g := Round(total_green);
		5341	slo^[tx].b := Round(total_blue);
		5342	end;
		5343	else
		5344	// You can implement this procedure for 16,8,4,2 and 32 BitCount's DIB
		5345	Exit;
		5346	end;
		5347	end;
		5348	end;
1	daniel-mar	5349	end;
		5350
4	daniel-mar	5351	function TDIB.TrimInt(i, Min, Max: Integer): Integer;
		5352	begin
		5353	if i > Max then
		5354	Result := Max
		5355	else
		5356	if i < Min then
		5357	Result := Min
		5358	else
		5359	Result := i;
		5360	end;
		5361
		5362	function TDIB.IntToByte(i: Integer): Byte;
		5363	begin
		5364	if i > 255 then
		5365	Result := 255
		5366	else
		5367	if i < 0 then
		5368	Result := 0
		5369	else
		5370	Result := i;
		5371	end;
		5372
		5373	//--------------------------------------------------------------------------------------------------
		5374	// End of these New Special Effect //
		5375	// Please contributes to add effects and filters to this collection //
		5376	// Please, work to implement 32,16,8,4,2 BitCount's DIB //
		5377	// Have fun - Mickey - Good job //
		5378	//--------------------------------------------------------------------------------------------------
		5379
		5380	function TDIB.GetAlphaChannel: TDIB;
16	daniel-mar	5381	var
		5382	I: Integer;
4	daniel-mar	5383	begin
		5384	RetAlphaChannel(Result);
16	daniel-mar	5385	if Result = nil then Exit;
4	daniel-mar	5386
16	daniel-mar	5387	if FFreeList.Count > 0 then
		5388	for I := 0 to FFreeList.Count - 1 do
		5389	if FFreeList[I] = Result then Exit;
		5390
4	daniel-mar	5391	FFreeList.Add(Result);
		5392	end;
		5393
		5394	procedure TDIB.SetAlphaChannel(const Value: TDIB);
		5395	begin
		5396	if not AssignAlphaChannel(Value{$IFNDEF VER4UP}, False{$ENDIF}) then
		5397	Exception.Create('Cannot set alphachannel from DIB.');
		5398	end;
		5399
		5400	procedure TDIB.Fill(aColor: TColor);
16	daniel-mar	5401	var
		5402	p: PRGBA;
		5403	y: Integer;
		5404	x: Integer;
4	daniel-mar	5405	begin
		5406	Canvas.Brush.Color := aColor;
		5407	Canvas.FillRect(ClientRect);
16	daniel-mar	5408	if Self.BitCount = 32 then
		5409	begin
		5410	//fill alpha chanell too with $FF
		5411	for Y := 0 to Self.Height - 1 do
		5412	begin
		5413	p := Self.ScanLine[Y];
		5414	for X := 0 to Self.Width - 1 do
		5415	begin
		5416	p[X].rgbReserved := $FF
		5417	end;
		5418	end;
		5419	end;
4	daniel-mar	5420	end;
		5421
		5422	function TDIB.GetClientRect: TRect;
		5423	begin
		5424	Result := Bounds(0, 0, Width, Height);
		5425	end;
		5426
1	daniel-mar	5427	{ TCustomDXDIB }
		5428
		5429	constructor TCustomDXDIB.Create(AOnwer: TComponent);
		5430	begin
		5431	inherited Create(AOnwer);
		5432	FDIB := TDIB.Create;
		5433	end;
		5434
		5435	destructor TCustomDXDIB.Destroy;
		5436	begin
		5437	FDIB.Free;
		5438	inherited Destroy;
		5439	end;
		5440
		5441	procedure TCustomDXDIB.SetDIB(Value: TDIB);
		5442	begin
		5443	FDIB.Assign(Value);
		5444	end;
		5445
		5446	{ TCustomDXPaintBox }
		5447
		5448	constructor TCustomDXPaintBox.Create(AOwner: TComponent);
		5449	begin
		5450	inherited Create(AOwner);
		5451	FDIB := TDIB.Create;
		5452
		5453	ControlStyle := ControlStyle + [csReplicatable];
		5454	Height := 105;
		5455	Width := 105;
		5456	end;
		5457
		5458	destructor TCustomDXPaintBox.Destroy;
		5459	begin
		5460	FDIB.Free;
		5461	inherited Destroy;
		5462	end;
		5463
		5464	function TCustomDXPaintBox.GetPalette: HPALETTE;
		5465	begin
		5466	Result := FDIB.Palette;
		5467	end;
		5468
		5469	procedure TCustomDXPaintBox.Paint;
		5470
		5471	procedure Draw2(Width, Height: Integer);
		5472	begin
4	daniel-mar	5473	if (Width <> FDIB.Width) or (Height <> FDIB.Height) then
1	daniel-mar	5474	begin
		5475	if FCenter then
		5476	begin
4	daniel-mar	5477	inherited Canvas.StretchDraw(Bounds(-(Width - ClientWidth) div 2,
		5478	-(Height - ClientHeight) div 2, Width, Height), FDIB);
		5479	end
		5480	else
1	daniel-mar	5481	begin
		5482	inherited Canvas.StretchDraw(Bounds(0, 0, Width, Height), FDIB);
		5483	end;
4	daniel-mar	5484	end
		5485	else
1	daniel-mar	5486	begin
		5487	if FCenter then
		5488	begin
4	daniel-mar	5489	inherited Canvas.Draw(-(Width - ClientWidth) div 2, -(Height - ClientHeight) div 2,
1	daniel-mar	5490	FDIB);
4	daniel-mar	5491	end
		5492	else
1	daniel-mar	5493	begin
		5494	inherited Canvas.Draw(0, 0, FDIB);
		5495	end;
		5496	end;
		5497	end;
		5498
		5499	var
		5500	r, r2: Single;
		5501	ViewWidth2, ViewHeight2: Integer;
		5502	begin
		5503	inherited Paint;
		5504
		5505	with inherited Canvas do
		5506	begin
		5507	if (csDesigning in ComponentState) then
		5508	begin
		5509	Pen.Style := psDash;
		5510	Brush.Style := bsClear;
		5511	Rectangle(0, 0, Width, Height);
		5512	end;
		5513
		5514	if FDIB.Empty then Exit;
		5515
4	daniel-mar	5516	if (FViewWidth > 0) or (FViewHeight > 0) then
1	daniel-mar	5517	begin
		5518	ViewWidth2 := FViewWidth;
4	daniel-mar	5519	if ViewWidth2 = 0 then ViewWidth2 := FDIB.Width;
1	daniel-mar	5520	ViewHeight2 := FViewHeight;
4	daniel-mar	5521	if ViewHeight2 = 0 then ViewHeight2 := FDIB.Height;
1	daniel-mar	5522
		5523	if FAutoStretch then
		5524	begin
4	daniel-mar	5525	if (ClientWidth < ViewWidth2) or (ClientHeight < ViewHeight2) then
1	daniel-mar	5526	begin
4	daniel-mar	5527	r := ViewWidth2 / ClientWidth;
		5528	r2 := ViewHeight2 / ClientHeight;
		5529	if r > r2 then
1	daniel-mar	5530	r := r2;
4	daniel-mar	5531	Draw2(Round(r * ClientWidth), Round(r * ClientHeight));
		5532	end
		5533	else
1	daniel-mar	5534	Draw2(ViewWidth2, ViewHeight2);
4	daniel-mar	5535	end
		5536	else
1	daniel-mar	5537	Draw2(ViewWidth2, ViewHeight2);
4	daniel-mar	5538	end
		5539	else
1	daniel-mar	5540	begin
		5541	if FAutoStretch then
		5542	begin
4	daniel-mar	5543	if (FDIB.Width > ClientWidth) or (FDIB.Height > ClientHeight) then
1	daniel-mar	5544	begin
4	daniel-mar	5545	r := ClientWidth / FDIB.Width;
		5546	r2 := ClientHeight / FDIB.Height;
		5547	if r > r2 then
1	daniel-mar	5548	r := r2;
4	daniel-mar	5549	Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height));
		5550	end
		5551	else
1	daniel-mar	5552	Draw2(FDIB.Width, FDIB.Height);
4	daniel-mar	5553	end
		5554	else
		5555	if FStretch then
1	daniel-mar	5556	begin
4	daniel-mar	5557	if FKeepAspect then
		5558	begin
		5559	r := ClientWidth / FDIB.Width;
		5560	r2 := ClientHeight / FDIB.Height;
		5561	if r > r2 then
		5562	r := r2;
		5563	Draw2(Round(r * FDIB.Width), Round(r * FDIB.Height));
		5564	end
		5565	else
		5566	Draw2(ClientWidth, ClientHeight);
		5567	end
		5568	else
		5569	Draw2(FDIB.Width, FDIB.Height);
1	daniel-mar	5570	end;
		5571	end;
		5572	end;
		5573
		5574	procedure TCustomDXPaintBox.SetAutoStretch(Value: Boolean);
		5575	begin
4	daniel-mar	5576	if FAutoStretch <> Value then
1	daniel-mar	5577	begin
		5578	FAutoStretch := Value;
		5579	Invalidate;
		5580	end;
		5581	end;
		5582
		5583	procedure TCustomDXPaintBox.SetCenter(Value: Boolean);
		5584	begin
4	daniel-mar	5585	if FCenter <> Value then
1	daniel-mar	5586	begin
		5587	FCenter := Value;
		5588	Invalidate;
		5589	end;
		5590	end;
		5591
		5592	procedure TCustomDXPaintBox.SetDIB(Value: TDIB);
		5593	begin
4	daniel-mar	5594	if FDIB <> Value then
1	daniel-mar	5595	begin
		5596	FDIB.Assign(Value);
		5597	Invalidate;
		5598	end;
		5599	end;
		5600
		5601	procedure TCustomDXPaintBox.SetKeepAspect(Value: Boolean);
		5602	begin
4	daniel-mar	5603	if Value <> FKeepAspect then
1	daniel-mar	5604	begin
		5605	FKeepAspect := Value;
		5606	Invalidate;
		5607	end;
		5608	end;
		5609
		5610	procedure TCustomDXPaintBox.SetStretch(Value: Boolean);
		5611	begin
4	daniel-mar	5612	if Value <> FStretch then
1	daniel-mar	5613	begin
		5614	FStretch := Value;
		5615	Invalidate;
		5616	end;
		5617	end;
		5618
		5619	procedure TCustomDXPaintBox.SetViewWidth(Value: Integer);
		5620	begin
4	daniel-mar	5621	if Value < 0 then Value := 0;
		5622	if Value <> FViewWidth then
1	daniel-mar	5623	begin
		5624	FViewWidth := Value;
		5625	Invalidate;
		5626	end;
		5627	end;
		5628
		5629	procedure TCustomDXPaintBox.SetViewHeight(Value: Integer);
		5630	begin
4	daniel-mar	5631	if Value < 0 then Value := 0;
		5632	if Value <> FViewHeight then
1	daniel-mar	5633	begin
		5634	FViewHeight := Value;
		5635	Invalidate;
		5636	end;
		5637	end;
		5638
4	daniel-mar	5639	{ DXFusion -> }
		5640
		5641	function PosValue(Value: Integer): Integer;
		5642	begin
		5643	if Value < 0 then result := 0 else result := Value;
		5644	end;
		5645
		5646	procedure TDIB.CreateDIBFromBitmap(const Bitmap: TBitmap);
		5647	var
		5648	pf: Integer;
16	daniel-mar	5649	X, Y: Integer;
		5650	P: PLinesA;
		5651	q: PRGBA;
4	daniel-mar	5652	begin
		5653	if Bitmap.PixelFormat = pf32bit then pf := 32 else pf := 24;
		5654	SetSize(Bitmap.Width, Bitmap.Height, pf); {always >=24}
16	daniel-mar	5655	Canvas.Brush.Color := clWhite;
		5656	Canvas.FillRect(Bounds(0, 0, Width, Height));
4	daniel-mar	5657	Canvas.Draw(0, 0, Bitmap);
16	daniel-mar	5658	//Note. Transparent background from bitmap is not drawed when is alphalayer active
		5659	if (pf = 32) {and (Bitmap.AlphaFormat <> afIgnored)} then
		5660	begin
		5661	for y := 0 to Bitmap.Height-1 do
		5662	begin
		5663	p := Bitmap.ScanLine[y]; //BGRA
		5664	q := Self.ScanLine[y]; //ARGB
		5665	for x := 0 to Width-1 do //copy only alphachannel
		5666	q[x].rgbReserved := P[x].A;
		5667	end;
		5668	end;
4	daniel-mar	5669	end;
		5670
		5671	function TDIB.CreateBitmapFromDIB: TBitmap;
16	daniel-mar	5672	var
		5673	ach: Boolean;
		5674	X, Y: Integer;
		5675	P: PLinesA;
		5676	q: PRGBA;
4	daniel-mar	5677	begin
16	daniel-mar	5678	ach := False;
4	daniel-mar	5679	Result := TBitmap.Create;
16	daniel-mar	5680	case BitCount of
		5681	32:
		5682	begin
		5683	Result.PixelFormat := pf32bit;
		5684	ach := HasAlphaChannel;
		5685	end;
		5686	24: Result.PixelFormat := pf24bit;
		5687	15: Result.PixelFormat := pf16bit;
		5688	8: Result.PixelFormat := pf8bit;
		5689	else
		5690	Result.PixelFormat := pf24bit;
		5691	end;
		5692
4	daniel-mar	5693	Result.Width := Width;
		5694	Result.Height := Height;
		5695	Result.Canvas.Draw(0, 0, Self);
16	daniel-mar	5696	if (BitCount = 32) then
		5697	begin
		5698	if ach then
		5699	begin
		5700	{$IFDEF VER16UP}
		5701	Result.AlphaFormat := afDefined;
		5702	{$ENDIF}
		5703	for y := 0 to Height-1 do
		5704	begin
		5705	p := Result.ScanLine[y]; //BGRA
		5706	q := Self.ScanLine[y]; //ARGB
		5707	for x := 0 to Width-1 do //copy only alphachannel
		5708	P[x].A := q[x].rgbReserved;
		5709	end;
		5710	end;
		5711	end;
4	daniel-mar	5712	end;
		5713
		5714	procedure TDIB.DrawTo(SrcDIB: TDIB; X, Y, Width, Height,
		5715	SourceX, SourceY: Integer);
		5716	begin
		5717	SrcDIB.DrawOn(Rect(X, Y, Width, Height), Self.Canvas, SourceX, SourceY);
		5718	end;
		5719
		5720	procedure TDIB.DrawTransparent(SrcDIB: TDIB; const X, Y, Width, Height,
		5721	SourceX, SourceY: Integer; const Color: TColor);
		5722	var
		5723	i, j: Integer;
		5724	k1, k2: Integer;
		5725	n: Integer;
		5726	p1, p2: PByteArray;
		5727
		5728	Startk1, Startk2: Integer;
		5729
		5730	StartY: Integer;
		5731	EndY: Integer;
		5732
		5733	DestStartY: Integer;
		5734	begin
		5735	if Self.BitCount <> 24 then Exit;
		5736	if SrcDIB.BitCount <> 24 then Exit;
		5737	Startk1 := 3 * SourceX;
		5738	Startk2 := 3 * X;
		5739
		5740	DestStartY := Y - SourceY;
		5741
		5742	StartY := SourceY;
		5743	EndY := SourceY + Height;
		5744
		5745	if (StartY + DestStartY < 0) then
		5746	StartY := -DestStartY;
		5747	if (EndY + DestStartY > Self.Height) then
		5748	EndY := Self.Height - DestStartY;
		5749
		5750	if (StartY < 0) then
		5751	StartY := 0;
		5752	if (EndY > SrcDIB.Height) then
		5753	EndY := SrcDIB.Height;
		5754
		5755	for j := StartY to EndY - 1 do
		5756	begin
		5757	p1 := Self.Scanline[j + DestStartY];
		5758	p2 := SrcDIB.Scanline[j];
		5759
		5760	k1 := Startk1;
		5761	k2 := Startk2;
		5762
		5763	for i := SourceX to SourceX + Width - 1 do
		5764	begin
		5765	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		5766
		5767	if not (n = Color) then
		5768	begin
		5769	p1[k2] := p2[k1];
		5770	p1[k2 + 1] := p2[k1 + 1];
		5771	p1[k2 + 2] := p2[k1 + 2];
		5772	end;
		5773
		5774	k1 := k1 + 3;
		5775	k2 := k2 + 3;
		5776	end;
		5777	end;
		5778	end;
		5779
		5780	procedure TDIB.DrawShadow(SrcDIB: TDIB; X, Y, Width, Height,
		5781	Frame: Integer; FilterMode: TFilterMode);
		5782	var
		5783	i, j: Integer;
		5784	p1, p2: PByte;
		5785	FW: Integer;
		5786	begin
		5787	if Self.BitCount <> 24 then Exit;
		5788	if SrcDIB.BitCount <> 24 then Exit;
		5789
		5790	FW := Frame * Width;
		5791	for i := 1 to Height - 1 do
		5792	begin
		5793	p1 := Self.Scanline[i + Y];
		5794	p2 := SrcDIB.Scanline[i];
		5795	Inc(p1, 3 * (X + 1));
		5796	Inc(p2, 3 * (FW + 1));
		5797	for j := 1 to Width - 1 do
		5798	begin
		5799	if (p2^ = 0) then
		5800	begin
		5801	case FilterMode of
		5802	fmNormal, fmMix50:
		5803	begin
		5804	p1^ := p1^ shr 1; // Blue
		5805	Inc(p1);
		5806	p1^ := p1^ shr 1; // Green
		5807	Inc(p1);
		5808	p1^ := p1^ shr 1; // Red
		5809	Inc(p1);
		5810	end;
		5811	fmMix25:
		5812	begin
		5813	p1^ := p1^ - p1^ shr 2; // Blue
		5814	Inc(p1);
		5815	p1^ := p1^ - p1^ shr 2; // Green
		5816	Inc(p1);
		5817	p1^ := p1^ - p1^ shr 2; // Red
		5818	Inc(p1);
		5819	end;
		5820	fmMix75:
		5821	begin
		5822	p1^ := p1^ shr 2; // Blue
		5823	Inc(p1);
		5824	p1^ := p1^ shr 2; // Green
		5825	Inc(p1);
		5826	p1^ := p1^ shr 2; // Red
		5827	Inc(p1);
		5828	end;
		5829	end;
		5830	end
		5831	else
		5832	Inc(p1, 3); // Not in the loop...
		5833	Inc(p2, 3);
		5834	end;
		5835	end;
		5836	end;
		5837
		5838	procedure TDIB.DrawShadows(SrcDIB: TDIB; X, Y, Width, Height,
		5839	Frame: Integer; Alpha: Byte);
		5840	{plynule nastavovani stiny dle alpha}
		5841	type
		5842	P3ByteArray = ^T3ByteArray;
		5843	T3ByteArray = array[0..32767] of TBGR;
		5844	var
		5845	i, j, l1, l2: Integer;
		5846	p1, p2: P3ByteArray;
		5847	FW: Integer;
		5848	begin
		5849	if Self.BitCount <> 24 then Exit;
		5850	if SrcDIB.BitCount <> 24 then Exit;
		5851
		5852	FW := Frame * Width;
		5853	for i := 0 to Height - 1 do
		5854	begin
		5855	p1 := Self.Scanline[i + Y];
		5856	p2 := SrcDIB.Scanline[i];
		5857	l1 := X;
		5858	l2 := FW;
		5859	for j := 0 to Width - 1 do
		5860	begin
		5861	if (p2[j + l2].B = 0) and (p2[j + l2].G = 0) and (p2[j + l2].R = 0) then
		5862	begin
		5863	p1[J + l1].B := Round(p1[J + l1].B / $FF * Alpha);
		5864	p1[J + l1].G := Round(p1[J + l1].G / $FF * Alpha);
		5865	p1[J + l1].R := Round(p1[J + l1].R / $FF * Alpha);
		5866	end
		5867	end;
		5868	end;
		5869	end;
		5870
		5871	procedure TDIB.DrawDarken(SrcDIB: TDIB; X, Y, Width, Height,
		5872	Frame: Integer);
		5873	var
		5874	frameoffset, i, j: Integer;
		5875	p1, p2: pByte;
		5876	XOffset: Integer;
		5877	begin
		5878	if Self.BitCount <> 24 then Exit;
		5879	if SrcDIB.BitCount <> 24 then Exit;
		5880
		5881	frameoffset := 3 * (Frame * Width) + 3;
		5882	XOffset := 3 * X + 3;
		5883	for i := 1 to Height - 1 do
		5884	begin
		5885	p1 := Self.Scanline[i + Y];
		5886	p2 := SrcDIB.Scanline[i];
		5887	inc(p1, XOffset);
		5888	inc(p2, frameoffset);
		5889	for j := 1 to Width - 1 do
		5890	begin
		5891	p1^ := (p2^ * p1^) shr 8; // R
		5892	inc(p1);
		5893	inc(p2);
		5894	p1^ := (p2^ * p1^) shr 8; // G
		5895	inc(p1);
		5896	inc(p2);
		5897	p1^ := (p2^ * p1^) shr 8; // B
		5898	inc(p1);
		5899	inc(p2);
		5900	end;
		5901	end;
		5902	end;
		5903
		5904	procedure TDIB.DrawQuickAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
		5905	SourceX, SourceY: Integer; const Color: TColor; FilterMode: TFilterMode);
		5906	var
		5907	i, j: Integer;
		5908	k1, k2: Integer;
		5909	n: Integer;
		5910	p1, p2: PByteArray;
		5911	BitSwitch1, BitSwitch2: Boolean;
		5912
		5913	Startk1, Startk2: Integer;
		5914	StartY: Integer;
		5915	EndY: Integer;
		5916
		5917	DestStartY: Integer;
		5918	begin
		5919	if Self.BitCount <> 24 then Exit;
		5920	if SrcDIB.BitCount <> 24 then Exit;
		5921
		5922	Startk1 := 3 * SourceX;
		5923	Startk2 := 3 * X;
		5924
		5925	DestStartY := Y - SourceY;
		5926
		5927	StartY := SourceY;
		5928	EndY := SourceY + Height;
		5929
		5930	if (StartY + DestStartY < 0) then
		5931	StartY := -DestStartY;
		5932	if (EndY + DestStartY > Self.Height) then
		5933	EndY := Self.Height - DestStartY;
		5934
		5935	if (StartY < 0) then
		5936	StartY := 0;
		5937	if (EndY > SrcDIB.Height) then
		5938	EndY := SrcDIB.Height;
		5939
		5940	if Odd(Y) then BitSwitch1 := true else BitSwitch1 := false;
		5941	if Odd(X) then BitSwitch2 := true else BitSwitch2 := false;
		5942
		5943	for j := StartY to EndY - 1 do
		5944	begin
		5945	BitSwitch1 := not BitSwitch1;
		5946	p1 := Self.Scanline[j + DestStartY];
		5947	p2 := SrcDIB.Scanline[j];
		5948
		5949	k1 := Startk1;
		5950	k2 := Startk2;
		5951
		5952	for i := SourceX to SourceX + Width - 1 do
		5953	begin
		5954	BitSwitch2 := not BitSwitch2;
		5955
		5956	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		5957
		5958	case FilterMode of
		5959	fmNormal, fmMix50: if not (n = Color) and (BitSwitch1 xor BitSwitch2) then
		5960	begin
		5961	p1[k2] := p2[k1];
		5962	p1[k2 + 1] := p2[k1 + 1];
		5963	p1[k2 + 2] := p2[k1 + 2];
		5964	end;
		5965	fmMix25: if not (n = Color) and (BitSwitch1 and BitSwitch2) then
		5966	begin
		5967	p1[k2] := p2[k1];
		5968	p1[k2 + 1] := p2[k1 + 1];
		5969	p1[k2 + 2] := p2[k1 + 2];
		5970	end;
		5971	fmMix75: if not (n = Color) and (BitSwitch1 or BitSwitch2) then
		5972	begin
		5973	p1[k2] := p2[k1];
		5974	p1[k2 + 1] := p2[k1 + 1];
		5975	p1[k2 + 2] := p2[k1 + 2];
		5976	end;
		5977	end;
		5978
		5979	k1 := k1 + 3;
		5980	k2 := k2 + 3;
		5981	end;
		5982	end;
		5983	end;
		5984
		5985	procedure TDIB.DrawAdditive(SrcDIB: TDIB; X, Y, Width, Height, Alpha, Frame:
		5986	Integer);
		5987	var
		5988	frameoffset, i, j, Wid: Integer;
		5989	p1, p2: pByte;
		5990	begin
		5991	if Self.BitCount <> 24 then Exit;
		5992	if SrcDIB.BitCount <> 24 then Exit;
		5993
		5994	if (Alpha < 1) or (Alpha > 256) then Exit;
		5995	Wid := Width shl 1 + Width;
		5996	frameoffset := Wid * Frame;
		5997	for i := 1 to Height - 1 do
		5998	begin
		5999	if (i + Y) > (Self.Height - 1) then Break; //add 25.5.2004 JB.
		6000	p1 := Self.Scanline[i + Y];
		6001	p2 := SrcDIB.Scanline[i];
		6002	inc(p1, X shl 1 + X + 3);
		6003	inc(p2, frameoffset + 3);
		6004	for j := 3 to Wid - 4 do
		6005	begin
		6006	inc(p1^, (Alpha - p1^) * p2^ shr 8);
		6007	inc(p1);
		6008	inc(p2);
		6009	end;
		6010	end;
		6011	end;
		6012
		6013	procedure TDIB.DrawTranslucent(SrcDIB: TDIB; const X, Y, Width, Height,
		6014	SourceX, SourceY: Integer; const Color: TColor);
		6015	var
		6016	i, j: Integer;
		6017	k1, k2: Integer;
		6018	n: Integer;
		6019	p1, p2: PByteArray;
		6020
		6021	Startk1, Startk2: Integer;
		6022	StartY: Integer;
		6023	EndY: Integer;
		6024
		6025	DestStartY: Integer;
		6026	begin
		6027	if Self.BitCount <> 24 then Exit;
		6028	if SrcDIB.BitCount <> 24 then Exit;
		6029
		6030	Startk1 := 3 * SourceX;
		6031	Startk2 := 3 * X;
		6032
		6033	DestStartY := Y - SourceY;
		6034
		6035	StartY := SourceY;
		6036	EndY := SourceY + Height;
		6037
		6038	if (StartY + DestStartY < 0) then
		6039	StartY := -DestStartY;
		6040	if (EndY + DestStartY > Self.Height) then
		6041	EndY := Self.Height - DestStartY;
		6042
		6043	if (StartY < 0) then
		6044	StartY := 0;
		6045	if (EndY > SrcDIB.Height) then
		6046	EndY := SrcDIB.Height;
		6047
		6048	for j := StartY to EndY - 1 do
		6049	begin
		6050	p1 := Self.Scanline[j + DestStartY];
		6051	p2 := SrcDIB.Scanline[j];
		6052
		6053	k1 := Startk1;
		6054	k2 := Startk2;
		6055
		6056	for i := SourceX to SourceX + Width - 1 do
		6057	begin
		6058	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		6059
		6060	if not (n = Color) then
		6061	begin
		6062	p1[k2] := (p1[k2] + p2[k1]) shr 1;
		6063	p1[k2 + 1] := (p1[k2 + 1] + p2[k1 + 1]) shr 1;
		6064	p1[k2 + 2] := (p1[k2 + 2] + p2[k1 + 2]) shr 1;
		6065	end;
		6066
		6067	k1 := k1 + 3;
		6068	k2 := k2 + 3;
		6069	end;
		6070	end;
		6071	end;
		6072
		6073	procedure TDIB.DrawAlpha(SrcDIB: TDIB; const X, Y, Width, Height,
		6074	SourceX, SourceY, Alpha: Integer; const Color: TColor);
		6075	var
		6076	i, j: Integer;
		6077	k1, k2: Integer;
		6078	n: Integer;
		6079	p1, p2: PByteArray;
		6080
		6081	Startk1, Startk2: Integer;
		6082	StartY: Integer;
		6083	EndY: Integer;
		6084
		6085	DestStartY: Integer;
		6086	begin
		6087	if Self.BitCount <> 24 then Exit;
		6088	if SrcDIB.BitCount <> 24 then Exit;
		6089
		6090	Startk1 := 3 * SourceX;
		6091	Startk2 := 3 * x;
		6092
		6093	DestStartY := Y - SourceY;
		6094
		6095	StartY := SourceY;
		6096	EndY := SourceY + Height;
		6097
		6098	if (EndY + DestStartY > Self.Height) then
		6099	EndY := Self.Height - DestStartY;
		6100
		6101	if (EndY > SrcDIB.Height) then
		6102	EndY := SrcDIB.Height;
		6103
		6104	if (StartY < 0) then
		6105	StartY := 0;
		6106
		6107	if (StartY + DestStartY < 0) then
		6108	StartY := DestStartY;
		6109
		6110	for j := StartY to EndY - 1 do
		6111	begin
		6112	p1 := Self.Scanline[j + DestStartY];
		6113	p2 := SrcDIB.Scanline[j];
		6114
		6115	k1 := Startk1;
		6116	k2 := Startk2;
		6117
		6118	for i := SourceX to SourceX + Width - 1 do
		6119	begin
		6120	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		6121
		6122	if not (n = Color) then
		6123	begin
		6124	p1[k2] := (p1[k2] * (256 - Alpha) + p2[k1] * Alpha) shr 8;
		6125	p1[k2 + 1] := (p1[k2 + 1] * (256 - Alpha) + p2[k1 + 1] * Alpha) shr 8;
		6126	p1[k2 + 2] := (p1[k2 + 2] * (256 - Alpha) + p2[k1 + 2] * Alpha) shr 8;
		6127	end;
		6128
		6129	k1 := k1 + 3;
		6130	k2 := k2 + 3;
		6131	end;
		6132	end;
		6133	end;
		6134
		6135	procedure TDIB.DrawAlphaMask(SrcDIB, MaskDIB: TDIB; const X, Y,
		6136	Width, Height, SourceX, SourceY: Integer);
		6137	var
		6138	i, j: Integer;
		6139	k1, k2, k3: Integer;
		6140	p1, p2, p3: PByteArray;
		6141
		6142	Startk1, Startk2: Integer;
		6143	StartY: Integer;
		6144	EndY: Integer;
		6145
		6146	DestStartY: Integer;
		6147	begin
		6148	if Self.BitCount <> 24 then Exit;
		6149	if SrcDIB.BitCount <> 24 then Exit;
		6150
		6151	Startk1 := 3 * SourceX;
		6152	Startk2 := 3 * x;
		6153
		6154	DestStartY := Y - SourceY;
		6155
		6156	StartY := SourceY;
		6157	EndY := SourceY + Height;
		6158
		6159	if (EndY + DestStartY > Self.Height) then
		6160	EndY := Self.Height - DestStartY;
		6161
		6162	if (EndY > SrcDIB.Height) then
		6163	EndY := SrcDIB.Height;
		6164
		6165	if (StartY < 0) then
		6166	StartY := 0;
		6167
		6168	if (StartY + DestStartY < 0) then
		6169	StartY := DestStartY;
		6170
		6171	for j := StartY to EndY - 1 do
		6172	begin
		6173	p1 := Self.Scanline[j + DestStartY];
		6174	p2 := SrcDIB.Scanline[j];
		6175	p3 := MaskDIB.Scanline[j];
		6176
		6177	k1 := Startk1;
		6178	k2 := Startk2;
		6179	k3 := 0;
		6180
		6181	for i := SourceX to SourceX + Width - 1 do
		6182	begin
		6183	p1[k2] := (p1[k2] * (256 - p3[k3]) + p2[k1] * p3[k3]) shr 8;
		6184	p1[k2 + 1] := (p1[k2 + 1] * (256 - p3[k3]) + p2[k1 + 1] * p3[k3]) shr 8;
		6185	p1[k2 + 2] := (p1[k2 + 2] * (256 - p3[k3]) + p2[k1 + 2] * p3[k3]) shr 8;
		6186
		6187	k1 := k1 + 3;
		6188	k2 := k2 + 3;
		6189	k3 := k3 + 3;
		6190	end;
		6191	end;
		6192	end;
		6193
		6194	procedure TDIB.DrawMorphed(SrcDIB: TDIB; const X, Y, Width, Height,
		6195	SourceX, SourceY: Integer; const Color: TColor);
		6196	var
		6197	i, j, r, g, b: Integer;
		6198	k1, k2: Integer;
		6199	n: Integer;
		6200	p1, p2: PByteArray;
		6201
		6202	Startk1, Startk2: Integer;
		6203	StartY: Integer;
		6204	EndY: Integer;
		6205
		6206	DestStartY: Integer;
		6207	begin
		6208	if Self.BitCount <> 24 then Exit;
		6209	if SrcDIB.BitCount <> 24 then Exit;
		6210
		6211	Startk1 := 3 * SourceX;
		6212	Startk2 := 3 * x;
		6213
		6214	DestStartY := Y - SourceY;
		6215
		6216	StartY := SourceY;
		6217	EndY := SourceY + Height;
		6218
		6219	if (EndY + DestStartY > Self.Height) then
		6220	EndY := Self.Height - DestStartY;
		6221
		6222	if (EndY > SrcDIB.Height) then
		6223	EndY := SrcDIB.Height;
		6224
		6225	if (StartY < 0) then
		6226	StartY := 0;
		6227
		6228	if (StartY + DestStartY < 0) then
		6229	StartY := DestStartY;
		6230
		6231	r := 0;
		6232	g := 0;
		6233	b := 0;
		6234
		6235	for j := StartY to EndY - 1 do
		6236	begin
		6237	p1 := Self.Scanline[j + DestStartY];
		6238	p2 := SrcDIB.Scanline[j];
		6239
		6240	k1 := Startk1;
		6241	k2 := Startk2;
		6242
		6243	for i := SourceX to SourceX + Width - 1 do
		6244	begin
		6245	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		6246
		6247	if Random(100) < 50 then
		6248	begin
		6249	b := p1[k2];
		6250	g := p1[k2 + 1];
		6251	r := p1[k2 + 2];
		6252	end;
		6253
		6254	if not (n = Color) then
		6255	begin
		6256	p1[k2] := b;
		6257	p1[k2 + 1] := g;
		6258	p1[k2 + 2] := r;
		6259	end;
		6260
		6261	k1 := k1 + 3;
		6262	k2 := k2 + 3;
		6263	end;
		6264	end;
		6265	end;
		6266
		6267	procedure TDIB.DrawMono(SrcDIB: TDIB; const X, Y, Width, Height,
		6268	SourceX, SourceY: Integer; const TransColor, ForeColor, BackColor: TColor);
		6269	var
		6270	i, j, r1, g1, b1, r2, g2, b2: Integer;
		6271	k1, k2: Integer;
		6272	n: Integer;
		6273	p1, p2: PByteArray;
		6274	Startk1, Startk2, StartY, EndY, DestStartY: Integer;
		6275	begin
		6276	if Self.BitCount <> 24 then Exit;
		6277	if SrcDIB.BitCount <> 24 then Exit;
		6278
		6279	Startk1 := 3 * SourceX;
		6280	Startk2 := 3 * x;
		6281
		6282	DestStartY := Y - SourceY;
		6283
		6284	StartY := SourceY;
		6285	EndY := SourceY + Height;
		6286
		6287	if (EndY + DestStartY > Self.Height) then
		6288	EndY := Self.Height - DestStartY;
		6289
		6290	if (EndY > SrcDIB.Height) then
		6291	EndY := SrcDIB.Height;
		6292
		6293	if (StartY < 0) then
		6294	StartY := 0;
		6295
		6296	if (StartY + DestStartY < 0) then
		6297	StartY := DestStartY;
		6298
		6299	r1 := GetRValue(BackColor);
		6300	g1 := GetGValue(BackColor);
		6301	b1 := GetBValue(BackColor);
		6302
		6303	r2 := GetRValue(ForeColor);
		6304	g2 := GetGValue(ForeColor);
		6305	b2 := GetBValue(ForeColor);
		6306
		6307
		6308	for j := StartY to EndY - 1 do
		6309	begin
		6310	p1 := Self.Scanline[j + DestStartY];
		6311	p2 := SrcDIB.Scanline[j];
		6312
		6313	k1 := Startk1;
		6314	k2 := Startk2;
		6315
		6316	for i := SourceX to SourceX + Width - 1 do
		6317	begin
		6318	n := (p2[k1] shl 16) + (p2[k1 + 1] shl 8) + p2[k1 + 2];
		6319
		6320	if (n = TransColor) then
		6321	begin
		6322	p1[k2] := b1;
		6323	p1[k2 + 1] := g1;
		6324	p1[k2 + 2] := r1;
		6325	end
		6326	else
		6327	begin
		6328	p1[k2] := b2;
		6329	p1[k2 + 1] := g2;
		6330	p1[k2 + 2] := r2;
		6331	end;
		6332
		6333	k1 := k1 + 3;
		6334	k2 := k2 + 3;
		6335	end;
		6336	end;
		6337	end;
		6338
		6339	procedure TDIB.Draw3x3Matrix(SrcDIB: TDIB; Setting: TMatrixSetting);
		6340	var i, j, k: Integer;
		6341	p1, p2, p3, p4: PByteArray;
		6342	begin
		6343	if Self.BitCount <> 24 then Exit;
		6344	if SrcDIB.BitCount <> 24 then Exit;
		6345
		6346	for i := 1 to SrcDIB.Height - 2 do
		6347	begin
		6348	p1 := SrcDIB.ScanLine[i - 1];
		6349	p2 := SrcDIB.ScanLine[i];
		6350	p3 := SrcDIB.ScanLine[i + 1];
		6351	p4 := Self.ScanLine[i];
		6352	for j := 3 to 3 * SrcDIB.Width - 4 do
		6353	begin
		6354	k := (p1[j - 3] * Setting[0] + p1[j] * Setting[1] + p1[j + 3] * Setting[2] +
		6355	p2[j - 3] * Setting[3] + p2[j] * Setting[4] + p2[j + 3] * Setting[5] +
		6356	p3[j - 3] * Setting[6] + p3[j] * Setting[7] + p3[j + 3] * Setting[8])
		6357	div Setting[9];
		6358	if k < 0 then k := 0;
		6359	if k > 255 then k := 255;
		6360	p4[j] := k;
		6361	end;
		6362	end;
		6363	end;
		6364
		6365	procedure TDIB.DrawAntialias(SrcDIB: TDIB);
		6366	var i, j, k, l, m: Integer;
		6367	p1, p2, p3: PByteArray;
		6368	begin
		6369	if Self.BitCount <> 24 then Exit;
		6370	if SrcDIB.BitCount <> 24 then Exit;
		6371
		6372	for i := 1 to Self.Height - 1 do
		6373	begin
		6374	k := i shl 1;
		6375	p1 := SrcDIB.Scanline[k];
		6376	p2 := SrcDIB.Scanline[k + 1];
		6377	p3 := Self.Scanline[i];
		6378	for j := 1 to Self.Width - 1 do
		6379	begin
		6380	m := 3 * j;
		6381	l := m shl 1;
		6382	p3[m] := (p1[l] + p1[l + 3] + p2[l] + p2[l + 3]) shr 2;
		6383	p3[m + 1] := (p1[l + 1] + p1[l + 4] + p2[l + 1] + p2[l + 4]) shr 2;
		6384	p3[m + 2] := (p1[l + 2] + p1[l + 5] + p2[l + 2] + p2[l + 5]) shr 2;
		6385	end;
		6386	end;
		6387	end;
		6388
		6389	procedure TDIB.FilterLine(X1, Y1, X2, Y2: Integer; Color: TColor;
		6390	FilterMode: TFilterMode);
		6391	var
		6392	i, j: Integer;
		6393	t: TColor;
		6394	r1, g1, b1, r2, g2, b2: Integer;
		6395	begin
		6396	j := ROUND(Sqrt(Sqr(ABS(X2 - X1)) + Sqr(ABS(Y2 - Y1))));
		6397	if j < 1 then Exit;
		6398
		6399	r1 := GetRValue(Color);
		6400	g1 := GetGValue(Color);
		6401	b1 := GetBValue(Color);
		6402
		6403	for i := 0 to j do
		6404	begin
		6405	t := Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)];
		6406	r2 := GetRValue(t);
		6407	g2 := GetGValue(t);
		6408	b2 := GetBValue(t);
		6409	case FilterMode of
		6410	fmNormal: t := RGB(r1 + (((256 - r1) * r2) shr 8),
		6411	g1 + (((256 - g1) * g2) shr 8),
		6412	b1 + (((256 - b1) * b2) shr 8));
		6413	fmMix25: t := RGB((r1 + r2 * 3) shr 2, (g1 + g2 * 3) shr 2, (b1 + b2 * 3) shr 2);
		6414	fmMix50: t := RGB((r1 + r2) shr 1, (g1 + g2) shr 1, (b1 + b2) shr 1);
		6415	fmMix75: t := RGB((r1 * 3 + r2) shr 2, (g1 * 3 + g2) shr 2, (b1 * 3 + b2) shr 2);
		6416	end;
		6417	Self.Pixels[X1 + ((X2 - X1) * i div j), Y1 + ((Y2 - Y1) * i div j)] := t;
		6418	end;
		6419	end;
		6420
		6421	procedure TDIB.FilterRect(X, Y, Width, Height: Integer;
		6422	Color: TColor; FilterMode: TFilterMode);
		6423	var
		6424	i, j, r, g, b, C1: Integer;
		6425	p1, p2, p3: pByte;
		6426	begin
		6427	if Self.BitCount <> 24 then Exit;
		6428
		6429	r := GetRValue(Color);
		6430	g := GetGValue(Color);
		6431	b := GetBValue(Color);
		6432
		6433	for i := 0 to Height - 1 do
		6434	begin
		6435	p1 := Self.Scanline[i + Y];
		6436	Inc(p1, (3 * X));
		6437	for j := 0 to Width - 1 do
		6438	begin
		6439	case FilterMode of
		6440	fmNormal:
		6441	begin
		6442	p2 := p1;
		6443	Inc(p2);
		6444	p3 := p2;
		6445	Inc(p3);
		6446	C1 := (p1^ + p2^ + p3^) div 3;
		6447
		6448	p1^ := (C1 * b) shr 8;
		6449	Inc(p1);
		6450	p1^ := (C1 * g) shr 8;
		6451	Inc(p1);
		6452	p1^ := (C1 * r) shr 8;
		6453	Inc(p1);
		6454	end;
		6455	fmMix25:
		6456	begin
		6457	p1^ := (3 * p1^ + b) shr 2;
		6458	Inc(p1);
		6459	p1^ := (3 * p1^ + g) shr 2;
		6460	Inc(p1);
		6461	p1^ := (3 * p1^ + r) shr 2;
		6462	Inc(p1);
		6463	end;
		6464	fmMix50:
		6465	begin
		6466	p1^ := (p1^ + b) shr 1;
		6467	Inc(p1);
		6468	p1^ := (p1^ + g) shr 1;
		6469	Inc(p1);
		6470	p1^ := (p1^ + r) shr 1;
		6471	Inc(p1);
		6472	end;
		6473	fmMix75:
		6474	begin
		6475	p1^ := (p1^ + 3 * b) shr 2;
		6476	Inc(p1);
		6477	p1^ := (p1^ + 3 * g) shr 2;
		6478	Inc(p1);
		6479	p1^ := (p1^ + 3 * r) shr 2;
		6480	Inc(p1);
		6481	end;
		6482	end;
		6483	end;
		6484	end;
		6485	end;
		6486
		6487	procedure TDIB.InitLight(Count, Detail: Integer);
		6488	var
		6489	i, j: Integer;
		6490	begin
		6491	LG_COUNT := Count;
		6492	LG_DETAIL := Detail;
		6493
		6494	for i := 0 to 255 do // Build Lightning LUT
		6495	for j := 0 to 255 do
		6496	FLUTDist[i, j] := ROUND(Sqrt(Sqr(i * 10) + Sqr(j * 10)));
		6497	end;
		6498
		6499	procedure TDIB.DrawLights(FLight: TLightArray;
		6500	AmbientLight: TColor);
		6501	var
		6502	i, j, l, m, n, o, q, D1, D2, R, G, B, AR, AG, AB: Integer;
		6503	P: array{$IFNDEF VER4UP} [0..4096]{$ENDIF} of PByteArray;
		6504	begin
		6505	if Self.BitCount <> 24 then Exit;
		6506
		6507	{$IFDEF VER4UP}
		6508	SetLength(P, LG_DETAIL);
		6509	{$ENDIF}
		6510	AR := GetRValue(AmbientLight);
		6511	AG := GetGValue(AmbientLight);
		6512	AB := GetBValue(AmbientLight);
		6513
		6514	for i := (Self.Height div (LG_DETAIL + 1)) downto 1 do
		6515	begin
		6516	for o := 0 to LG_DETAIL do
		6517	P[o] := Self.Scanline[(LG_DETAIL + 1) * i - o];
		6518
		6519	for j := (Self.Width div (LG_DETAIL + 1)) downto 1 do
		6520	begin
		6521	R := AR;
		6522	G := AG;
		6523	B := AB;
		6524
		6525	for l := LG_COUNT - 1 downto 0 do // Check the lightsources
		6526	begin
		6527	D1 := ABS(j * (LG_DETAIL + 1) - FLight[l].X) div FLight[l].Size1;
		6528	D2 := ABS(i * (LG_DETAIL + 1) - FLight[l].Y) div FLight[l].Size2;
		6529	if D1 > 255 then D1 := 255;
		6530	if D2 > 255 then D2 := 255;
		6531
		6532	m := 255 - FLUTDist[D1, D2];
		6533	if m < 0 then m := 0;
		6534
		6535	Inc(R, (PosValue(GetRValue(FLight[l].Color) - R) * m shr 8));
		6536	Inc(G, (PosValue(GetGValue(FLight[l].Color) - G) * m shr 8));
		6537	Inc(B, (PosValue(GetBValue(FLight[l].Color) - B) * m shr 8));
		6538	end;
		6539
		6540	for q := LG_DETAIL downto 0 do
		6541	begin
		6542	n := 3 * (j * (LG_DETAIL + 1) - q);
		6543
		6544	for o := LG_DETAIL downto 0 do
		6545	begin
		6546	P[o][n] := (P[o][n] * B) shr 8;
		6547	P[o][n + 1] := (P[o][n + 1] * G) shr 8;
		6548	P[o][n + 2] := (P[o][n + 2] * R) shr 8;
		6549	end;
		6550	end;
		6551	end;
		6552	end;
		6553	{$IFDEF VER4UP}
		6554	SetLength(P, 0);
		6555	{$ENDIF}
		6556	end;
		6557
		6558	procedure TDIB.DrawOn(Dest: TRect; DestCanvas: TCanvas; Xsrc, Ysrc: Integer);
		6559	{procedure is supplement of original TDIBUltra function}
		6560	begin
		6561	//if not AsSigned(SrcCanvas) then Exit;
		6562	if (Xsrc < 0) then
		6563	begin
		6564	Dec(Dest.Left, Xsrc);
		6565	Inc(Dest.Right {Width }, Xsrc);
		6566	Xsrc := 0
		6567	end;
		6568	if (Ysrc < 0) then
		6569	begin
		6570	Dec(Dest.Top, Ysrc);
		6571	Inc(Dest.Bottom {Height}, Ysrc);
		6572	Ysrc := 0
		6573	end;
		6574	BitBlt(DestCanvas.Handle, Dest.Left, Dest.Top, Dest.Right, Dest.Bottom, Self.Canvas.Handle, Xsrc, Ysrc, SRCCOPY);
		6575	end;
		6576
		6577	{ DXFusion <- }
		6578
		6579	{ added effect for DIB }
		6580
		6581	function IntToByte(i: Integer): Byte;
		6582	begin
		6583	if i > 255 then Result := 255
		6584	else if i < 0 then Result := 0
		6585	else Result := i;
		6586	end;
		6587
		6588	{standalone routine}
		6589
		6590	procedure TDIB.Darker(Percent: Integer);
		6591	{color to dark in percent}
		6592	var
		6593	p0: pbytearray;
		6594	r, g, b, x, y: Integer;
		6595	begin
		6596	if Self.BitCount <> 24 then Exit;
		6597	for y := 0 to Self.Height - 1 do
		6598	begin
		6599	p0 := Self.ScanLine[y];
		6600	for x := 0 to Self.Width - 1 do
		6601	begin
		6602	r := p0[x * 3];
		6603	g := p0[x * 3 + 1];
		6604	b := p0[x * 3 + 2];
		6605	p0[x * 3] := Round(R * Percent / 100);
		6606	p0[x * 3 + 1] := Round(G * Percent / 100);
		6607	p0[x * 3 + 2] := Round(B * Percent / 100);
		6608	end;
		6609	end;
		6610	end;
		6611
		6612	procedure TDIB.Lighter(Percent: Integer);
		6613	var
		6614	p0: pbytearray;
		6615	r, g, b, x, y: Integer;
		6616	begin
		6617	if Self.BitCount <> 24 then Exit;
		6618	for y := 0 to Self.Height - 1 do
		6619	begin
		6620	p0 := Self.ScanLine[y];
		6621	for x := 0 to Self.Width - 1 do
		6622	begin
		6623	r := p0[x * 3];
		6624	g := p0[x * 3 + 1];
		6625	b := p0[x * 3 + 2];
		6626	p0[x * 3] := Round(R * Percent / 100) + Round(255 - Percent / 100 * 255);
		6627	p0[x * 3 + 1] := Round(G * Percent / 100) + Round(255 - Percent / 100 * 255);
		6628	p0[x * 3 + 2] := Round(B * Percent / 100) + Round(255 - Percent / 100 * 255);
		6629	end;
		6630	end;
		6631	end;
		6632
		6633	procedure TDIB.Darkness(Amount: Integer);
		6634	var
		6635	p0: pbytearray;
		6636	r, g, b, x, y: Integer;
		6637	begin
		6638	if Self.BitCount <> 24 then Exit;
		6639	for y := 0 to Self.Height - 1 do
		6640	begin
		6641	p0 := Self.ScanLine[y];
		6642	for x := 0 to Self.Width - 1 do
		6643	begin
		6644	r := p0[x * 3];
		6645	g := p0[x * 3 + 1];
		6646	b := p0[x * 3 + 2];
		6647	p0[x * 3] := IntToByte(r - ((r) * Amount) div 255);
		6648	p0[x * 3 + 1] := IntToByte(g - ((g) * Amount) div 255);
		6649	p0[x * 3 + 2] := IntToByte(b - ((b) * Amount) div 255);
		6650	end;
		6651	end;
		6652	end;
		6653
		6654	function TrimInt(i, Min, Max: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		6655	begin
		6656	if i > Max then Result := Max
		6657	else if i < Min then Result := Min
		6658	else Result := i;
		6659	end;
		6660
		6661	procedure TDIB.DoSmoothRotate(Src: TDIB; cx, cy: Integer; Angle: Extended);
		6662	var
16	daniel-mar	6663	Top, Bottom, eww, nsw, fx, fy: Extended;
4	daniel-mar	6664	cAngle, sAngle: Double;
		6665	xDiff, yDiff, ifx, ify, px, py, ix, iy, x, y: Integer;
		6666	nw, ne, sw, se: TBGR;
		6667	P1, P2, P3: Pbytearray;
		6668	begin
		6669	Angle := angle;
		6670	Angle := -Angle * Pi / 180;
		6671	sAngle := Sin(Angle);
		6672	cAngle := Cos(Angle);
		6673	xDiff := (Self.Width - Src.Width) div 2;
		6674	yDiff := (Self.Height - Src.Height) div 2;
		6675	for y := 0 to Self.Height - 1 do
		6676	begin
		6677	P3 := Self.scanline[y];
		6678	py := 2 * (y - cy) + 1;
		6679	for x := 0 to Self.Width - 1 do
		6680	begin
		6681	px := 2 * (x - cx) + 1;
		6682	fx := (((px * cAngle - py * sAngle) - 1) / 2 + cx) - xDiff;
		6683	fy := (((px * sAngle + py * cAngle) - 1) / 2 + cy) - yDiff;
		6684	ifx := Round(fx);
		6685	ify := Round(fy);
		6686
		6687	if (ifx > -1) and (ifx < Src.Width) and (ify > -1) and (ify < Src.Height) then
		6688	begin
		6689	eww := fx - ifx;
		6690	nsw := fy - ify;
		6691	iy := TrimInt(ify + 1, 0, Src.Height - 1);
		6692	ix := TrimInt(ifx + 1, 0, Src.Width - 1);
		6693	P1 := Src.scanline[ify];
		6694	P2 := Src.scanline[iy];
		6695	nw.r := P1[ifx * 3];
		6696	nw.g := P1[ifx * 3 + 1];
		6697	nw.b := P1[ifx * 3 + 2];
		6698	ne.r := P1[ix * 3];
		6699	ne.g := P1[ix * 3 + 1];
		6700	ne.b := P1[ix * 3 + 2];
		6701	sw.r := P2[ifx * 3];
		6702	sw.g := P2[ifx * 3 + 1];
		6703	sw.b := P2[ifx * 3 + 2];
		6704	se.r := P2[ix * 3];
		6705	se.g := P2[ix * 3 + 1];
		6706	se.b := P2[ix * 3 + 2];
		6707
		6708	Top := nw.b + eww * (ne.b - nw.b);
		6709	Bottom := sw.b + eww * (se.b - sw.b);
		6710	P3[x * 3 + 2] := IntToByte(Round(Top + nsw * (Bottom - Top)));
		6711
		6712	Top := nw.g + eww * (ne.g - nw.g);
		6713	Bottom := sw.g + eww * (se.g - sw.g);
		6714	P3[x * 3 + 1] := IntToByte(Round(Top + nsw * (Bottom - Top)));
		6715
		6716	Top := nw.r + eww * (ne.r - nw.r);
		6717	Bottom := sw.r + eww * (se.r - sw.r);
		6718	P3[x * 3] := IntToByte(Round(Top + nsw * (Bottom - Top)));
		6719	end;
		6720	end;
		6721	end;
		6722	end;
		6723
		6724	//----------------------
		6725	//--- 24 bit count routines ----------------------
		6726	//----------------------
		6727
		6728	procedure TDIB.DoInvert;
		6729	procedure PicInvert(src: TDIB);
		6730	var w, h, x, y: Integer;
		6731	p: pbytearray;
		6732	begin
		6733	w := src.width;
		6734	h := src.height;
		6735	src.BitCount := 24;
		6736	for y := 0 to h - 1 do
		6737	begin
		6738	p := src.scanline[y];
		6739	for x := 0 to w - 1 do
		6740	begin
		6741	p[x * 3] := not p[x * 3];
		6742	p[x * 3 + 1] := not p[x * 3 + 1];
		6743	p[x * 3 + 2] := not p[x * 3 + 2];
		6744	end;
		6745	end;
		6746	end;
		6747	begin
		6748	PicInvert(Self);
		6749	end;
		6750
		6751	procedure TDIB.DoAddColorNoise(Amount: Integer);
		6752	procedure AddColorNoise(var clip: TDIB; Amount: Integer);
		6753	var
		6754	p0: pbytearray;
		6755	x, y, r, g, b: Integer;
		6756	begin
		6757	for y := 0 to clip.Height - 1 do
		6758	begin
		6759	p0 := clip.ScanLine[y];
		6760	for x := 0 to clip.Width - 1 do
		6761	begin
		6762	r := p0[x * 3] + (Random(Amount) - (Amount shr 1));
		6763	g := p0[x * 3 + 1] + (Random(Amount) - (Amount shr 1));
		6764	b := p0[x * 3 + 2] + (Random(Amount) - (Amount shr 1));
		6765	p0[x * 3] := IntToByte(r);
		6766	p0[x * 3 + 1] := IntToByte(g);
		6767	p0[x * 3 + 2] := IntToByte(b);
		6768	end;
		6769	end;
		6770	end;
		6771	var BB: TDIB;
		6772	begin
		6773	BB := TDIB.Create;
		6774	BB.BitCount := 24;
		6775	BB.Assign(Self);
		6776	AddColorNoise(bb, Amount);
		6777	Self.Assign(BB);
		6778	BB.Free;
		6779	end;
		6780
		6781	procedure TDIB.DoAddMonoNoise(Amount: Integer);
		6782	procedure _AddMonoNoise(var clip: TDIB; Amount: Integer);
		6783	var
		6784	p0: pbytearray;
		6785	x, y, a, r, g, b: Integer;
		6786	begin
		6787	for y := 0 to clip.Height - 1 do
		6788	begin
		6789	p0 := clip.scanline[y];
		6790	for x := 0 to clip.Width - 1 do
		6791	begin
		6792	a := Random(Amount) - (Amount shr 1);
		6793	r := p0[x * 3] + a;
		6794	g := p0[x * 3 + 1] + a;
		6795	b := p0[x * 3 + 2] + a;
		6796	p0[x * 3] := IntToByte(r);
		6797	p0[x * 3 + 1] := IntToByte(g);
		6798	p0[x * 3 + 2] := IntToByte(b);
		6799	end;
		6800	end;
		6801	end;
		6802	var BB: TDIB;
		6803	begin
		6804	BB := TDIB.Create;
		6805	BB.BitCount := 24;
		6806	BB.Assign(Self);
		6807	_AddMonoNoise(bb, Amount);
		6808	Self.Assign(BB);
		6809	BB.Free;
		6810	end;
		6811
		6812	procedure TDIB.DoAntiAlias;
		6813	procedure AntiAlias(clip: TDIB);
		6814	procedure AntiAliasRect(clip: TDIB; XOrigin, YOrigin, XFinal, YFinal: Integer);
		6815	var Memo, x, y: Integer; (* Composantes primaires des points environnants *)
		6816	p0, p1, p2: pbytearray;
		6817	begin
		6818	if XFinal < XOrigin then begin Memo := XOrigin; XOrigin := XFinal; XFinal := Memo; end; (* Inversion des valeurs *)
		6819	if YFinal < YOrigin then begin Memo := YOrigin; YOrigin := YFinal; YFinal := Memo; end; (* si diff�rence n�gative*)
		6820	XOrigin := max(1, XOrigin);
		6821	YOrigin := max(1, YOrigin);
		6822	XFinal := min(clip.width - 2, XFinal);
		6823	YFinal := min(clip.height - 2, YFinal);
		6824	clip.BitCount := 24;
		6825	for y := YOrigin to YFinal do
		6826	begin
		6827	p0 := clip.ScanLine[y - 1];
		6828	p1 := clip.scanline[y];
		6829	p2 := clip.ScanLine[y + 1];
		6830	for x := XOrigin to XFinal do
		6831	begin
		6832	p1[x * 3] := (p0[x * 3] + p2[x * 3] + p1[(x - 1) * 3] + p1[(x + 1) * 3]) div 4;
		6833	p1[x * 3 + 1] := (p0[x * 3 + 1] + p2[x * 3 + 1] + p1[(x - 1) * 3 + 1] + p1[(x + 1) * 3 + 1]) div 4;
		6834	p1[x * 3 + 2] := (p0[x * 3 + 2] + p2[x * 3 + 2] + p1[(x - 1) * 3 + 2] + p1[(x + 1) * 3 + 2]) div 4;
		6835	end;
		6836	end;
		6837	end;
		6838	begin
		6839	AntiAliasRect(clip, 0, 0, clip.width, clip.height);
		6840	end;
		6841	begin
		6842	AntiAlias(Self);
		6843	end;
		6844
		6845	procedure TDIB.DoContrast(Amount: Integer);
		6846	procedure _Contrast(var clip: TDIB; Amount: Integer);
		6847	var
		6848	p0: pbytearray;
		6849	rg, gg, bg, r, g, b, x, y: Integer;
		6850	begin
		6851	for y := 0 to clip.Height - 1 do
		6852	begin
		6853	p0 := clip.scanline[y];
		6854	for x := 0 to clip.Width - 1 do
		6855	begin
		6856	r := p0[x * 3];
		6857	g := p0[x * 3 + 1];
		6858	b := p0[x * 3 + 2];
		6859	rg := (Abs(127 - r) * Amount) div 255;
		6860	gg := (Abs(127 - g) * Amount) div 255;
		6861	bg := (Abs(127 - b) * Amount) div 255;
		6862	if r > 127 then r := r + rg else r := r - rg;
		6863	if g > 127 then g := g + gg else g := g - gg;
		6864	if b > 127 then b := b + bg else b := b - bg;
		6865	p0[x * 3] := IntToByte(r);
		6866	p0[x * 3 + 1] := IntToByte(g);
		6867	p0[x * 3 + 2] := IntToByte(b);
		6868	end;
		6869	end;
		6870	end;
		6871	var BB: TDIB;
		6872	begin
		6873	BB := TDIB.Create;
		6874	BB.BitCount := 24;
		6875	BB.Assign(Self);
		6876	_Contrast(bb, Amount);
		6877	Self.Assign(BB);
		6878	BB.Free;
		6879	end;
		6880
		6881	procedure TDIB.DoFishEye(Amount: Integer);
		6882	procedure _FishEye(var Bmp, Dst: TDIB; Amount: Extended);
		6883	var
		6884	xmid, ymid: Single;
		6885	fx, fy: Single;
		6886	r1, r2: Single;
		6887	ifx, ify: Integer;
		6888	dx, dy: Single;
		6889	rmax: Single;
		6890	ty, tx: Integer;
		6891	weight_x, weight_y: array[0..1] of Single;
		6892	weight: Single;
		6893	new_red, new_green: Integer;
		6894	new_blue: Integer;
		6895	total_red, total_green: Single;
		6896	total_blue: Single;
		6897	ix, iy: Integer;
		6898	sli, slo: PByteArray;
		6899	begin
		6900	xmid := Bmp.Width / 2;
		6901	ymid := Bmp.Height / 2;
		6902	rmax := Dst.Width * Amount;
		6903
		6904	for ty := 0 to Dst.Height - 1 do
		6905	begin
		6906	for tx := 0 to Dst.Width - 1 do
		6907	begin
		6908	dx := tx - xmid;
		6909	dy := ty - ymid;
		6910	r1 := Sqrt(dx * dx + dy * dy);
		6911	if r1 = 0 then
		6912	begin
		6913	fx := xmid;
		6914	fy := ymid;
		6915	end
		6916	else
		6917	begin
		6918	r2 := rmax / 2 * (1 / (1 - r1 / rmax) - 1);
		6919	fx := dx * r2 / r1 + xmid;
		6920	fy := dy * r2 / r1 + ymid;
		6921	end;
		6922	ify := Trunc(fy);
		6923	ifx := Trunc(fx);
		6924	// Calculate the weights.
		6925	if fy >= 0 then
		6926	begin
		6927	weight_y[1] := fy - ify;
		6928	weight_y[0] := 1 - weight_y[1];
		6929	end
		6930	else
		6931	begin
		6932	weight_y[0] := -(fy - ify);
		6933	weight_y[1] := 1 - weight_y[0];
		6934	end;
		6935	if fx >= 0 then
		6936	begin
		6937	weight_x[1] := fx - ifx;
		6938	weight_x[0] := 1 - weight_x[1];
		6939	end
		6940	else
		6941	begin
		6942	weight_x[0] := -(fx - ifx);
		6943	Weight_x[1] := 1 - weight_x[0];
		6944	end;
		6945
		6946	if ifx < 0 then
		6947	ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
		6948	else if ifx > Bmp.Width - 1 then
		6949	ifx := ifx mod Bmp.Width;
		6950	if ify < 0 then
		6951	ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
		6952	else if ify > Bmp.Height - 1 then
		6953	ify := ify mod Bmp.Height;
		6954
		6955	total_red := 0.0;
		6956	total_green := 0.0;
		6957	total_blue := 0.0;
		6958	for ix := 0 to 1 do
		6959	begin
		6960	for iy := 0 to 1 do
		6961	begin
		6962	if ify + iy < Bmp.Height then
		6963	sli := Bmp.scanline[ify + iy]
		6964	else
		6965	sli := Bmp.scanline[Bmp.Height - ify - iy];
		6966	if ifx + ix < Bmp.Width then
		6967	begin
		6968	new_red := sli[(ifx + ix) * 3];
		6969	new_green := sli[(ifx + ix) * 3 + 1];
		6970	new_blue := sli[(ifx + ix) * 3 + 2];
		6971	end
		6972	else
		6973	begin
		6974	new_red := sli[(Bmp.Width - ifx - ix) * 3];
		6975	new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
		6976	new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
		6977	end;
		6978	weight := weight_x[ix] * weight_y[iy];
		6979	total_red := total_red + new_red * weight;
		6980	total_green := total_green + new_green * weight;
		6981	total_blue := total_blue + new_blue * weight;
		6982	end;
		6983	end;
		6984	slo := Dst.scanline[ty];
		6985	slo[tx * 3] := Round(total_red);
		6986	slo[tx * 3 + 1] := Round(total_green);
		6987	slo[tx * 3 + 2] := Round(total_blue);
		6988
		6989	end;
		6990	end;
		6991	end;
		6992	var BB1, BB2: TDIB;
		6993	begin
		6994	BB1 := TDIB.Create;
		6995	BB1.BitCount := 24;
		6996	BB1.Assign(Self);
		6997	BB2 := TDIB.Create;
		6998	BB2.BitCount := 24;
		6999	BB2.Assign(BB1);
		7000	_FishEye(BB1, BB2, Amount);
		7001	Self.Assign(BB2);
		7002	BB1.Free;
		7003	BB2.Free;
		7004	end;
		7005
		7006	procedure TDIB.DoGrayScale;
		7007	procedure GrayScale(var clip: TDIB);
		7008	var
		7009	p0: pbytearray;
		7010	Gray, x, y: Integer;
		7011	begin
		7012	for y := 0 to clip.Height - 1 do
		7013	begin
		7014	p0 := clip.scanline[y];
		7015	for x := 0 to clip.Width - 1 do
		7016	begin
		7017	Gray := Round(p0[x * 3] * 0.3 + p0[x * 3 + 1] * 0.59 + p0[x * 3 + 2] * 0.11);
		7018	p0[x * 3] := Gray;
		7019	p0[x * 3 + 1] := Gray;
		7020	p0[x * 3 + 2] := Gray;
		7021	end;
		7022	end;
		7023	end;
		7024	var BB: TDIB;
		7025	begin
		7026	BB := TDIB.Create;
		7027	BB.BitCount := 24;
		7028	BB.Assign(Self);
		7029	GrayScale(BB);
		7030	Self.Assign(BB);
		7031	BB.Free;
		7032	end;
		7033
		7034	procedure TDIB.DoLightness(Amount: Integer);
		7035	procedure _Lightness(var clip: TDIB; Amount: Integer);
		7036	var
		7037	p0: pbytearray;
		7038	r, g, b, x, y: Integer;
		7039	begin
		7040	for y := 0 to clip.Height - 1 do
		7041	begin
		7042	p0 := clip.scanline[y];
		7043	for x := 0 to clip.Width - 1 do
		7044	begin
		7045	r := p0[x * 3];
		7046	g := p0[x * 3 + 1];
		7047	b := p0[x * 3 + 2];
		7048	p0[x * 3] := IntToByte(r + ((255 - r) * Amount) div 255);
		7049	p0[x * 3 + 1] := IntToByte(g + ((255 - g) * Amount) div 255);
		7050	p0[x * 3 + 2] := IntToByte(b + ((255 - b) * Amount) div 255);
		7051	end;
		7052	end;
		7053	end;
		7054	var BB: TDIB;
		7055	begin
		7056	BB := TDIB.Create;
		7057	BB.BitCount := 24;
		7058	BB.Assign(Self);
		7059	_Lightness(BB, Amount);
		7060	Self.Assign(BB);
		7061	BB.Free;
		7062	end;
		7063
		7064	procedure TDIB.DoDarkness(Amount: Integer);
		7065	var BB: TDIB;
		7066	begin
		7067	BB := TDIB.Create;
		7068	BB.BitCount := 24;
		7069	BB.Assign(Self);
		7070	BB.Darkness(Amount);
		7071	Self.Assign(BB);
		7072	BB.Free;
		7073	end;
		7074
		7075	procedure TDIB.DoSaturation(Amount: Integer);
		7076	procedure _Saturation(var clip: TDIB; Amount: Integer);
		7077	var
		7078	p0: pbytearray;
		7079	Gray, r, g, b, x, y: Integer;
		7080	begin
		7081	for y := 0 to clip.Height - 1 do
		7082	begin
		7083	p0 := clip.scanline[y];
		7084	for x := 0 to clip.Width - 1 do
		7085	begin
		7086	r := p0[x * 3];
		7087	g := p0[x * 3 + 1];
		7088	b := p0[x * 3 + 2];
		7089	Gray := (r + g + b) div 3;
		7090	p0[x * 3] := IntToByte(Gray + (((r - Gray) * Amount) div 255));
		7091	p0[x * 3 + 1] := IntToByte(Gray + (((g - Gray) * Amount) div 255));
		7092	p0[x * 3 + 2] := IntToByte(Gray + (((b - Gray) * Amount) div 255));
		7093	end;
		7094	end;
		7095	end;
		7096	var BB: TDIB;
		7097	begin
		7098	BB := TDIB.Create;
		7099	BB.BitCount := 24;
		7100	BB.Assign(Self);
		7101	_Saturation(BB, Amount);
		7102	Self.Assign(BB);
		7103	BB.Free;
		7104	end;
		7105
		7106	procedure TDIB.DoSplitBlur(Amount: Integer);
		7107	{NOTE: For a gaussian blur is amount 3}
		7108	procedure _SplitBlur(var clip: TDIB; Amount: Integer);
		7109	var
		7110	p0, p1, p2: pbytearray;
		7111	cx, x, y: Integer;
		7112	Buf: array[0..3, 0..2] of byte;
		7113	begin
		7114	if Amount = 0 then Exit;
		7115	for y := 0 to clip.Height - 1 do
		7116	begin
		7117	p0 := clip.scanline[y];
		7118	if y - Amount < 0 then p1 := clip.scanline[y]
		7119	else {y-Amount>0} p1 := clip.ScanLine[y - Amount];
		7120	if y + Amount < clip.Height then p2 := clip.ScanLine[y + Amount]
		7121	else {y+Amount>=Height} p2 := clip.ScanLine[clip.Height - y];
		7122
		7123	for x := 0 to clip.Width - 1 do
		7124	begin
		7125	if x - Amount < 0 then cx := x
		7126	else {x-Amount>0} cx := x - Amount;
		7127	Buf[0, 0] := p1[cx * 3];
		7128	Buf[0, 1] := p1[cx * 3 + 1];
		7129	Buf[0, 2] := p1[cx * 3 + 2];
		7130	Buf[1, 0] := p2[cx * 3];
		7131	Buf[1, 1] := p2[cx * 3 + 1];
		7132	Buf[1, 2] := p2[cx * 3 + 2];
		7133	if x + Amount < clip.Width then cx := x + Amount
		7134	else {x+Amount>=Width} cx := clip.Width - x;
		7135	Buf[2, 0] := p1[cx * 3];
		7136	Buf[2, 1] := p1[cx * 3 + 1];
		7137	Buf[2, 2] := p1[cx * 3 + 2];
		7138	Buf[3, 0] := p2[cx * 3];
		7139	Buf[3, 1] := p2[cx * 3 + 1];
		7140	Buf[3, 2] := p2[cx * 3 + 2];
		7141	p0[x * 3] := (Buf[0, 0] + Buf[1, 0] + Buf[2, 0] + Buf[3, 0]) shr 2;
		7142	p0[x * 3 + 1] := (Buf[0, 1] + Buf[1, 1] + Buf[2, 1] + Buf[3, 1]) shr 2;
		7143	p0[x * 3 + 2] := (Buf[0, 2] + Buf[1, 2] + Buf[2, 2] + Buf[3, 2]) shr 2;
		7144	end;
		7145	end;
		7146	end;
		7147	var BB: TDIB;
		7148	begin
		7149	BB := TDIB.Create;
		7150	BB.BitCount := 24;
		7151	BB.Assign(Self);
		7152	_SplitBlur(BB, Amount);
		7153	Self.Assign(BB);
		7154	BB.Free;
		7155	end;
		7156
		7157	procedure TDIB.DoGaussianBlur(Amount: Integer);
		7158	var BB: TDIB;
		7159	begin
		7160	BB := TDIB.Create;
		7161	BB.BitCount := 24;
		7162	BB.BitCount := 24;
		7163	BB.Assign(Self);
		7164	GaussianBlur(BB, Amount);
		7165	Self.Assign(BB);
		7166	BB.Free;
		7167	end;
		7168
		7169	procedure TDIB.DoMosaic(Size: Integer);
		7170	procedure Mosaic(var Bm: TDIB; size: Integer);
		7171	var
		7172	x, y, i, j: Integer;
		7173	p1, p2: pbytearray;
		7174	r, g, b: byte;
		7175	begin
		7176	y := 0;
		7177	repeat
		7178	p1 := bm.scanline[y];
		7179	repeat
		7180	j := 1;
		7181	repeat
		7182	p2 := bm.scanline[y];
		7183	x := 0;
		7184	repeat
		7185	r := p1[x * 3];
		7186	g := p1[x * 3 + 1];
		7187	b := p1[x * 3 + 2];
		7188	i := 1;
		7189	repeat
		7190	p2[x * 3] := r;
		7191	p2[x * 3 + 1] := g;
		7192	p2[x * 3 + 2] := b;
		7193	inc(x);
		7194	inc(i);
		7195	until (x >= bm.width) or (i > size);
		7196	until x >= bm.width;
		7197	inc(j);
		7198	inc(y);
		7199	until (y >= bm.height) or (j > size);
		7200	until (y >= bm.height) or (x >= bm.width);
		7201	until y >= bm.height;
		7202	end;
		7203	var BB: TDIB;
		7204	begin
		7205	BB := TDIB.Create;
		7206	BB.BitCount := 24;
		7207	BB.Assign(Self);
		7208	Mosaic(BB, Size);
		7209	Self.Assign(BB);
		7210	BB.Free;
		7211	end;
		7212
		7213	procedure TDIB.DoTwist(Amount: Integer);
		7214	procedure _Twist(var Bmp, Dst: TDIB; Amount: Integer);
		7215	var
		7216	fxmid, fymid: Single;
		7217	txmid, tymid: Single;
		7218	fx, fy: Single;
		7219	tx2, ty2: Single;
		7220	r: Single;
		7221	theta: Single;
		7222	ifx, ify: Integer;
		7223	dx, dy: Single;
		7224	OFFSET: Single;
		7225	ty, tx: Integer;
		7226	weight_x, weight_y: array[0..1] of Single;
		7227	weight: Single;
		7228	new_red, new_green: Integer;
		7229	new_blue: Integer;
		7230	total_red, total_green: Single;
		7231	total_blue: Single;
		7232	ix, iy: Integer;
		7233	sli, slo: PBytearray;
		7234
		7235	function ArcTan2(xt, yt: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
		7236	begin
		7237	if xt = 0 then
		7238	if yt > 0 then
		7239	Result := Pi / 2
		7240	else
		7241	Result := -(Pi / 2)
		7242	else
		7243	begin
		7244	Result := ArcTan(yt / xt);
		7245	if xt < 0 then
		7246	Result := Pi + ArcTan(yt / xt);
		7247	end;
		7248	end;
		7249
		7250	begin
		7251	OFFSET := -(Pi / 2);
		7252	dx := Bmp.Width - 1;
		7253	dy := Bmp.Height - 1;
		7254	r := Sqrt(dx * dx + dy * dy);
		7255	tx2 := r;
		7256	ty2 := r;
		7257	txmid := (Bmp.Width - 1) / 2; //Adjust these to move center of rotation
		7258	tymid := (Bmp.Height - 1) / 2; //Adjust these to move ......
		7259	fxmid := (Bmp.Width - 1) / 2;
		7260	fymid := (Bmp.Height - 1) / 2;
		7261	if tx2 >= Bmp.Width then tx2 := Bmp.Width - 1;
		7262	if ty2 >= Bmp.Height then ty2 := Bmp.Height - 1;
		7263
		7264	for ty := 0 to Round(ty2) do
		7265	begin
		7266	for tx := 0 to Round(tx2) do
		7267	begin
		7268	dx := tx - txmid;
		7269	dy := ty - tymid;
		7270	r := Sqrt(dx * dx + dy * dy);
		7271	if r = 0 then
		7272	begin
		7273	fx := 0;
		7274	fy := 0;
		7275	end
		7276	else
		7277	begin
		7278	theta := ArcTan2(dx, dy) - r / Amount - OFFSET;
		7279	fx := r * Cos(theta);
		7280	fy := r * Sin(theta);
		7281	end;
		7282	fx := fx + fxmid;
		7283	fy := fy + fymid;
		7284
		7285	ify := Trunc(fy);
		7286	ifx := Trunc(fx);
		7287	// Calculate the weights.
		7288	if fy >= 0 then
		7289	begin
		7290	weight_y[1] := fy - ify;
		7291	weight_y[0] := 1 - weight_y[1];
		7292	end
		7293	else
		7294	begin
		7295	weight_y[0] := -(fy - ify);
		7296	weight_y[1] := 1 - weight_y[0];
		7297	end;
		7298	if fx >= 0 then
		7299	begin
		7300	weight_x[1] := fx - ifx;
		7301	weight_x[0] := 1 - weight_x[1];
		7302	end
		7303	else
		7304	begin
		7305	weight_x[0] := -(fx - ifx);
		7306	Weight_x[1] := 1 - weight_x[0];
		7307	end;
		7308
		7309	if ifx < 0 then
		7310	ifx := Bmp.Width - 1 - (-ifx mod Bmp.Width)
		7311	else if ifx > Bmp.Width - 1 then
		7312	ifx := ifx mod Bmp.Width;
		7313	if ify < 0 then
		7314	ify := Bmp.Height - 1 - (-ify mod Bmp.Height)
		7315	else if ify > Bmp.Height - 1 then
		7316	ify := ify mod Bmp.Height;
		7317
		7318	total_red := 0.0;
		7319	total_green := 0.0;
		7320	total_blue := 0.0;
		7321	for ix := 0 to 1 do
		7322	begin
		7323	for iy := 0 to 1 do
		7324	begin
		7325	if ify + iy < Bmp.Height then
		7326	sli := Bmp.scanline[ify + iy]
		7327	else
		7328	sli := Bmp.scanline[Bmp.Height - ify - iy];
		7329	if ifx + ix < Bmp.Width then
		7330	begin
		7331	new_red := sli[(ifx + ix) * 3];
		7332	new_green := sli[(ifx + ix) * 3 + 1];
		7333	new_blue := sli[(ifx + ix) * 3 + 2];
		7334	end
		7335	else
		7336	begin
		7337	new_red := sli[(Bmp.Width - ifx - ix) * 3];
		7338	new_green := sli[(Bmp.Width - ifx - ix) * 3 + 1];
		7339	new_blue := sli[(Bmp.Width - ifx - ix) * 3 + 2];
		7340	end;
		7341	weight := weight_x[ix] * weight_y[iy];
		7342	total_red := total_red + new_red * weight;
		7343	total_green := total_green + new_green * weight;
		7344	total_blue := total_blue + new_blue * weight;
		7345	end;
		7346	end;
		7347	slo := Dst.scanline[ty];
		7348	slo[tx * 3] := Round(total_red);
		7349	slo[tx * 3 + 1] := Round(total_green);
		7350	slo[tx * 3 + 2] := Round(total_blue);
		7351	end;
		7352	end;
		7353	end;
		7354	var BB1, BB2: TDIB;
		7355	begin
		7356	BB1 := TDIB.Create;
		7357	BB1.BitCount := 24;
		7358	BB1.Assign(Self);
		7359	BB2 := TDIB.Create;
		7360	BB2.BitCount := 24;
		7361	BB2.Assign(BB1);
		7362	_Twist(BB1, BB2, Amount);
		7363	Self.Assign(BB2);
		7364	BB1.Free;
		7365	BB2.Free;
		7366	end;
		7367
		7368	procedure TDIB.DoTrace(Amount: Integer);
		7369	procedure Trace(src: TDIB; intensity: Integer);
		7370	var
		7371	x, y, i: Integer;
		7372	P1, P2, P3, P4: PByteArray;
		7373	tb, TraceB: byte;
		7374	hasb: Boolean;
		7375	bitmap: TDIB;
		7376	begin
		7377	bitmap := TDIB.create;
		7378	bitmap.width := src.width;
		7379	bitmap.height := src.height;
		7380	bitmap.canvas.draw(0, 0, src);
		7381	bitmap.BitCount := 8;
		7382	src.BitCount := 24;
		7383	hasb := false;
		7384	TraceB := $00; tb := 0;
		7385	for i := 1 to Intensity do
		7386	begin
		7387	for y := 0 to BitMap.height - 2 do
		7388	begin
		7389	P1 := BitMap.ScanLine[y];
		7390	P2 := BitMap.scanline[y + 1];
		7391	P3 := src.scanline[y];
		7392	P4 := src.scanline[y + 1];
		7393	x := 0;
		7394	repeat
		7395	if p1[x] <> p1[x + 1] then
		7396	begin
		7397	if not hasb then
		7398	begin
		7399	tb := p1[x + 1];
		7400	hasb := true;
		7401	p3[x * 3] := TraceB;
		7402	p3[x * 3 + 1] := TraceB;
		7403	p3[x * 3 + 2] := TraceB;
		7404	end
		7405	else
		7406	begin
		7407	if p1[x] <> tb then
		7408	begin
		7409	p3[x * 3] := TraceB;
		7410	p3[x * 3 + 1] := TraceB;
		7411	p3[x * 3 + 2] := TraceB;
		7412	end
		7413	else
		7414	begin
		7415	p3[(x + 1) * 3] := TraceB;
		7416	p3[(x + 1) * 3 + 1] := TraceB;
		7417	p3[(x + 1) * 3 + 1] := TraceB;
		7418	end;
		7419	end;
		7420	end;
		7421	if p1[x] <> p2[x] then
		7422	begin
		7423	if not hasb then
		7424	begin
		7425	tb := p2[x];
		7426	hasb := true;
		7427	p3[x * 3] := TraceB;
		7428	p3[x * 3 + 1] := TraceB;
		7429	p3[x * 3 + 2] := TraceB;
		7430	end
		7431	else
		7432	begin
		7433	if p1[x] <> tb then
		7434	begin
		7435	p3[x * 3] := TraceB;
		7436	p3[x * 3 + 1] := TraceB;
		7437	p3[x * 3 + 2] := TraceB;
		7438	end
		7439	else
		7440	begin
		7441	p4[x * 3] := TraceB;
		7442	p4[x * 3 + 1] := TraceB;
		7443	p4[x * 3 + 2] := TraceB;
		7444	end;
		7445	end;
		7446	end;
		7447	inc(x);
		7448	until x >= (BitMap.width - 2);
		7449	end;
		7450	if i > 1 then
		7451	for y := BitMap.height - 1 downto 1 do
		7452	begin
		7453	P1 := BitMap.ScanLine[y];
		7454	P2 := BitMap.scanline[y - 1];
		7455	P3 := src.scanline[y];
		7456	P4 := src.scanline[y - 1];
		7457	x := Bitmap.width - 1;
		7458	repeat
		7459	if p1[x] <> p1[x - 1] then
		7460	begin
		7461	if not hasb then
		7462	begin
		7463	tb := p1[x - 1];
		7464	hasb := true;
		7465	p3[x * 3] := TraceB;
		7466	p3[x * 3 + 1] := TraceB;
		7467	p3[x * 3 + 2] := TraceB;
		7468	end
		7469	else
		7470	begin
		7471	if p1[x] <> tb then
		7472	begin
		7473	p3[x * 3] := TraceB;
		7474	p3[x * 3 + 1] := TraceB;
		7475	p3[x * 3 + 2] := TraceB;
		7476	end
		7477	else
		7478	begin
		7479	p3[(x - 1) * 3] := TraceB;
		7480	p3[(x - 1) * 3 + 1] := TraceB;
		7481	p3[(x - 1) * 3 + 2] := TraceB;
		7482	end;
		7483	end;
		7484	end;
		7485	if p1[x] <> p2[x] then
		7486	begin
		7487	if not hasb then
		7488	begin
		7489	tb := p2[x];
		7490	hasb := true;
		7491	p3[x * 3] := TraceB;
		7492	p3[x * 3 + 1] := TraceB;
		7493	p3[x * 3 + 2] := TraceB;
		7494	end
		7495	else
		7496	begin
		7497	if p1[x] <> tb then
		7498	begin
		7499	p3[x * 3] := TraceB;
		7500	p3[x * 3 + 1] := TraceB;
		7501	p3[x * 3 + 2] := TraceB;
		7502	end
		7503	else
		7504	begin
		7505	p4[x * 3] := TraceB;
		7506	p4[x * 3 + 1] := TraceB;
		7507	p4[x * 3 + 2] := TraceB;
		7508	end;
		7509	end;
		7510	end;
		7511	dec(x);
		7512	until x <= 1;
		7513	end;
		7514	end;
		7515	bitmap.free;
		7516	end;
		7517	var BB1, BB2: TDIB;
		7518	begin
		7519	BB1 := TDIB.Create;
		7520	BB1.BitCount := 24;
		7521	BB1.Assign(Self);
		7522	BB2 := TDIB.Create;
		7523	BB2.BitCount := 24;
		7524	BB2.Assign(BB1);
		7525	Trace(BB2, Amount);
		7526	Self.Assign(BB2);
		7527	BB1.Free;
		7528	BB2.Free;
		7529	end;
		7530
		7531	procedure TDIB.DoSplitlight(Amount: Integer);
		7532	procedure Splitlight(var clip: TDIB; amount: Integer);
		7533	var
		7534	x, y, i: Integer;
		7535	p1: pbytearray;
		7536
		7537	function sinpixs(a: Integer): Integer;
		7538	begin
		7539	result := variant(sin(a / 255 * pi / 2) * 255);
		7540	end;
		7541	begin
		7542	for i := 1 to amount do
		7543	for y := 0 to clip.height - 1 do
		7544	begin
		7545	p1 := clip.scanline[y];
		7546	for x := 0 to clip.width - 1 do
		7547	begin
		7548	p1[x * 3] := sinpixs(p1[x * 3]);
		7549	p1[x * 3 + 1] := sinpixs(p1[x * 3 + 1]);
		7550	p1[x * 3 + 2] := sinpixs(p1[x * 3 + 2]);
		7551	end;
		7552	end;
		7553	end;
		7554	var BB1 {,BB2}: TDIB;
		7555	begin
		7556	BB1 := TDIB.Create;
		7557	BB1.BitCount := 24;
		7558	BB1.Assign(Self);
		7559	// BB2 := TDIB.Create;
		7560	// BB2.BitCount := 24;
		7561	// BB2.Assign (BB1);
		7562	Splitlight(BB1, Amount);
		7563	Self.Assign(BB1);
		7564	BB1.Free;
		7565	// BB2.Free;
		7566	end;
		7567
		7568	procedure TDIB.DoTile(Amount: Integer);
		7569	procedure SmoothResize(var Src, Dst: TDIB);
		7570	var
		7571	x, y, xP, yP,
		7572	yP2, xP2: Integer;
		7573	Read, Read2: PByteArray;
		7574	t, z, z2, iz2: Integer;
		7575	pc: PBytearray;
		7576	w1, w2, w3, w4: Integer;
		7577	Col1r, col1g, col1b, Col2r, col2g, col2b: byte;
		7578	begin
		7579	xP2 := ((src.Width - 1) shl 15) div Dst.Width;
		7580	yP2 := ((src.Height - 1) shl 15) div Dst.Height;
		7581	yP := 0;
		7582	for y := 0 to Dst.Height - 1 do
		7583	begin
		7584	xP := 0;
		7585	Read := src.ScanLine[yP shr 15];
		7586	if yP shr 16 < src.Height - 1 then
		7587	Read2 := src.ScanLine[yP shr 15 + 1]
		7588	else
		7589	Read2 := src.ScanLine[yP shr 15];
		7590	pc := Dst.scanline[y];
		7591	z2 := yP and $7FFF;
		7592	iz2 := $8000 - z2;
		7593	for x := 0 to Dst.Width - 1 do
		7594	begin
		7595	t := xP shr 15;
		7596	Col1r := Read[t * 3];
		7597	Col1g := Read[t * 3 + 1];
		7598	Col1b := Read[t * 3 + 2];
		7599	Col2r := Read2[t * 3];
		7600	Col2g := Read2[t * 3 + 1];
		7601	Col2b := Read2[t * 3 + 2];
		7602	z := xP and $7FFF;
		7603	w2 := (z * iz2) shr 15;
		7604	w1 := iz2 - w2;
		7605	w4 := (z * z2) shr 15;
		7606	w3 := z2 - w4;
		7607	pc[x * 3 + 2] :=
		7608	(Col1b * w1 + Read[(t + 1) * 3 + 2] * w2 +
		7609	Col2b * w3 + Read2[(t + 1) * 3 + 2] * w4) shr 15;
		7610	pc[x * 3 + 1] :=
		7611	(Col1g * w1 + Read[(t + 1) * 3 + 1] * w2 +
		7612	Col2g * w3 + Read2[(t + 1) * 3 + 1] * w4) shr 15;
		7613	pc[x * 3] :=
		7614	(Col1r * w1 + Read2[(t + 1) * 3] * w2 +
		7615	Col2r * w3 + Read2[(t + 1) * 3] * w4) shr 15;
		7616	Inc(xP, xP2);
		7617	end;
		7618	Inc(yP, yP2);
		7619	end;
		7620	end;
		7621	procedure Tile(src, dst: TDIB; amount: Integer);
		7622	var
		7623	w, h, w2, h2, i, j: Integer;
		7624	bm: TDIB;
		7625	begin
		7626	w := src.width;
		7627	h := src.height;
		7628	dst.width := w;
		7629	dst.height := h;
		7630	dst.Canvas.draw(0, 0, src);
		7631	if (amount <= 0) or ((w div amount) < 5) or ((h div amount) < 5) then exit;
		7632	h2 := h div amount;
		7633	w2 := w div amount;
		7634	bm := TDIB.create;
		7635	bm.width := w2;
		7636	bm.height := h2;
		7637	bm.BitCount := 24;
		7638	smoothresize(src, bm);
		7639	for j := 0 to amount - 1 do
		7640	for i := 0 to amount - 1 do
		7641	dst.canvas.Draw(i * w2, j * h2, bm);
		7642	bm.free;
		7643	end;
		7644	var BB1, BB2: TDIB;
		7645	begin
		7646	BB1 := TDIB.Create;
		7647	BB1.BitCount := 24;
		7648	BB1.Assign(Self);
		7649	BB2 := TDIB.Create;
		7650	BB2.BitCount := 24;
		7651	BB2.Assign(BB1);
		7652	Tile(BB1, BB2, Amount);
		7653	Self.Assign(BB2);
		7654	BB1.Free;
		7655	BB2.Free;
		7656	end;
		7657
		7658	procedure TDIB.DoSpotLight(Amount: Integer; Spot: TRect);
		7659	procedure SpotLight(var src: TDIB; Amount: Integer; Spot: TRect);
		7660	var
		7661	bm, z: TDIB;
		7662	w, h: Integer;
		7663	begin
		7664	z := TDIB.Create;
		7665	try
		7666	z.SetSize(src.Width, src.Height, 24);
		7667	z.DrawTo(src, 0, 0, src.Width, src.Height, 0, 0);
		7668	w := z.Width;
		7669	h := z.Height;
		7670	bm := TDIB.create;
		7671	try
		7672	bm.Width := w;
		7673	bm.Height := h;
		7674	bm.Canvas.Brush.color := clblack;
		7675	bm.Canvas.FillRect(rect(0, 0, w, h));
		7676	bm.Canvas.Brush.Color := clwhite;
		7677	bm.Canvas.Ellipse(Spot.left, spot.top, spot.right, spot.bottom);
		7678	bm.Transparent := true;
		7679	z.Canvas.CopyMode := cmSrcAnd; {as transparentcolor for white}
		7680	z.Canvas.Draw(0, 0, src);
		7681	z.Canvas.Draw(0, 0, bm);
		7682	src.Darkness(Amount);
		7683	src.Canvas.CopyMode := cmSrcPaint;
		7684	src.DrawTransparent(z, 0, 0, z.Width, z.Height, 0, 0, clBlack);
		7685	finally
		7686	bm.Free;
		7687	end;
		7688	finally
		7689	z.Free
		7690	end;
		7691	end;
		7692	var BB1, BB2: TDIB;
		7693	begin
		7694	BB1 := TDIB.Create;
		7695	BB1.BitCount := 24;
		7696	BB1.Assign(Self);
		7697	BB2 := TDIB.Create;
		7698	BB2.BitCount := 24;
		7699	BB2.Assign(BB1);
		7700	SpotLight(BB2, Amount, Spot);
		7701	Self.Assign(BB2);
		7702	BB1.Free;
		7703	BB2.Free;
		7704	end;
		7705
		7706	procedure TDIB.DoEmboss;
		7707	procedure Emboss(var Bmp: TDIB);
		7708	var
		7709	x, y: Integer;
		7710	p1, p2: Pbytearray;
		7711	begin
		7712	for y := 0 to Bmp.Height - 2 do
		7713	begin
		7714	p1 := bmp.scanline[y];
		7715	p2 := bmp.scanline[y + 1];
		7716	for x := 0 to Bmp.Width - 4 do
		7717	begin
		7718	p1[x * 3] := (p1[x * 3] + (p2[(x + 3) * 3] xor $FF)) shr 1;
		7719	p1[x * 3 + 1] := (p1[x * 3 + 1] + (p2[(x + 3) * 3 + 1] xor $FF)) shr 1;
		7720	p1[x * 3 + 2] := (p1[x * 3 + 2] + (p2[(x + 3) * 3 + 2] xor $FF)) shr 1;
		7721	end;
		7722	end;
		7723	end;
		7724	var BB1, BB2: TDIB;
		7725	begin
		7726	BB1 := TDIB.Create;
		7727	BB1.BitCount := 24;
		7728	BB1.Assign(Self);
		7729	BB2 := TDIB.Create;
		7730	BB2.BitCount := 24;
		7731	BB2.Assign(BB1);
		7732	Emboss(BB2);
		7733	Self.Assign(BB2);
		7734	BB1.Free;
		7735	BB2.Free;
		7736	end;
		7737
		7738	procedure TDIB.DoSolorize(Amount: Integer);
		7739	procedure Solorize(src, dst: TDIB; amount: Integer);
		7740	var
		7741	w, h, x, y: Integer;
		7742	ps, pd: pbytearray;
		7743	c: Integer;
		7744	begin
		7745	w := src.width;
		7746	h := src.height;
		7747	src.BitCount := 24;
		7748	dst.BitCount := 24;
		7749	for y := 0 to h - 1 do
		7750	begin
		7751	ps := src.scanline[y];
		7752	pd := dst.scanline[y];
		7753	for x := 0 to w - 1 do
		7754	begin
		7755	c := (ps[x * 3] + ps[x * 3 + 1] + ps[x * 3 + 2]) div 3;
		7756	if c > amount then
		7757	begin
		7758	pd[x * 3] := 255 - ps[x * 3];
		7759	pd[x * 3 + 1] := 255 - ps[x * 3 + 1];
		7760	pd[x * 3 + 2] := 255 - ps[x * 3 + 2];
		7761	end
		7762	else
		7763	begin
		7764	pd[x * 3] := ps[x * 3];
		7765	pd[x * 3 + 1] := ps[x * 3 + 1];
		7766	pd[x * 3 + 2] := ps[x * 3 + 2];
		7767	end;
		7768	end;
		7769	end;
		7770	end;
		7771	var BB1, BB2: TDIB;
		7772	begin
		7773	BB1 := TDIB.Create;
		7774	BB1.BitCount := 24;
		7775	BB1.Assign(Self);
		7776	BB2 := TDIB.Create;
		7777	BB2.BitCount := 24;
		7778	BB2.Assign(BB1);
		7779	Solorize(BB1, BB2, Amount);
		7780	Self.Assign(BB2);
		7781	BB1.Free;
		7782	BB2.Free;
		7783	end;
		7784
		7785	procedure TDIB.DoPosterize(Amount: Integer);
		7786	procedure Posterize(src, dst: TDIB; amount: Integer);
		7787	var
		7788	w, h, x, y: Integer;
		7789	ps, pd: pbytearray;
		7790	begin
		7791	w := src.width;
		7792	h := src.height;
		7793	src.BitCount := 24;
		7794	dst.BitCount := 24;
		7795	for y := 0 to h - 1 do
		7796	begin
		7797	ps := src.scanline[y];
		7798	pd := dst.scanline[y];
		7799	for x := 0 to w - 1 do
		7800	begin
		7801	pd[x * 3] := round(ps[x * 3] / amount) * amount;
		7802	pd[x * 3 + 1] := round(ps[x * 3 + 1] / amount) * amount;
		7803	pd[x * 3 + 2] := round(ps[x * 3 + 2] / amount) * amount;
		7804	end;
		7805	end;
		7806	end;
		7807	var BB1, BB2: TDIB;
		7808	begin
		7809	BB1 := TDIB.Create;
		7810	BB1.BitCount := 24;
		7811	BB1.Assign(Self);
		7812	BB2 := TDIB.Create;
		7813	BB2.BitCount := 24;
		7814	BB2.Assign(BB1);
		7815	Posterize(BB1, BB2, Amount);
		7816	Self.Assign(BB2);
		7817	BB1.Free;
		7818	BB2.Free;
		7819	end;
		7820
		7821	procedure TDIB.DoBrightness(Amount: Integer);
		7822	procedure Brightness(src, dst: TDIB; level: Integer);
		7823	const
		7824	MaxPixelCount = 32768;
		7825	type
		7826	pRGBArray = ^TRGBArray;
		7827	TRGBArray = array[0..MaxPixelCount - 1] of TRGBTriple;
		7828	var
		7829	i, j, value: Integer;
		7830	OrigRow, DestRow: pRGBArray;
		7831	begin
		7832	// get brightness increment value
		7833	value := level;
		7834	src.BitCount := 24;
		7835	dst.BitCount := 24;
		7836	// for each row of pixels
		7837	for i := 0 to src.Height - 1 do
		7838	begin
		7839	OrigRow := src.ScanLine[i];
		7840	DestRow := dst.ScanLine[i];
		7841	// for each pixel in row
		7842	for j := 0 to src.Width - 1 do
		7843	begin
		7844	// add brightness value to pixel's RGB values
		7845	if value > 0 then
		7846	begin
		7847	// RGB values must be less than 256
		7848	DestRow[j].rgbtRed := Min(255, OrigRow[j].rgbtRed + value);
		7849	DestRow[j].rgbtGreen := Min(255, OrigRow[j].rgbtGreen + value);
		7850	DestRow[j].rgbtBlue := Min(255, OrigRow[j].rgbtBlue + value);
		7851	end
		7852	else
		7853	begin
		7854	// RGB values must be greater or equal than 0
		7855	DestRow[j].rgbtRed := Max(0, OrigRow[j].rgbtRed + value);
		7856	DestRow[j].rgbtGreen := Max(0, OrigRow[j].rgbtGreen + value);
		7857	DestRow[j].rgbtBlue := Max(0, OrigRow[j].rgbtBlue + value);
		7858	end;
		7859	end;
		7860	end;
		7861	end;
		7862	var BB1, BB2: TDIB;
		7863	begin
		7864	BB1 := TDIB.Create;
		7865	BB1.BitCount := 24;
		7866	BB1.Assign(Self);
		7867	BB2 := TDIB.Create;
		7868	BB2.BitCount := 24;
		7869	BB2.Assign(BB1);
		7870	Brightness(BB1, BB2, Amount);
		7871	Self.Assign(BB2);
		7872	BB1.Free;
		7873	BB2.Free;
		7874	end;
		7875
		7876	procedure TDIB.DoResample(AmountX, AmountY: Integer; TypeResample: TFilterTypeResample);
		7877	procedure Resample(Src, Dst: TDIB; filtertype: TFilterTypeResample; fwidth: single);
		7878	// -----------------------------------------------------------------------------
		7879	//
		7880	// Filter functions
		7881	//
		7882	// -----------------------------------------------------------------------------
		7883
		7884	// Hermite filter
16	daniel-mar	7885	function HermiteFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7886	begin
		7887	// f(t) = 2\|t\|^3 - 3\|t\|^2 + 1, -1 <= t <= 1
		7888	if (Value < 0.0) then
		7889	Value := -Value;
		7890	if (Value < 1.0) then
		7891	Result := (2.0 * Value - 3.0) * Sqr(Value) + 1.0
		7892	else
		7893	Result := 0.0;
		7894	end;
		7895
		7896	// Box filter
		7897	// a.k.a. "Nearest Neighbour" filter
		7898	// anme: I have not been able to get acceptable
		7899	// results with this filter for subsampling.
16	daniel-mar	7900	function BoxFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7901	begin
		7902	if (Value > -0.5) and (Value <= 0.5) then
		7903	Result := 1.0
		7904	else
		7905	Result := 0.0;
		7906	end;
		7907
		7908	// Triangle filter
		7909	// a.k.a. "Linear" or "Bilinear" filter
16	daniel-mar	7910	function TriangleFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7911	begin
		7912	if (Value < 0.0) then
		7913	Value := -Value;
		7914	if (Value < 1.0) then
		7915	Result := 1.0 - Value
		7916	else
		7917	Result := 0.0;
		7918	end;
		7919
		7920	// Bell filter
16	daniel-mar	7921	function BellFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7922	begin
		7923	if (Value < 0.0) then
		7924	Value := -Value;
		7925	if (Value < 0.5) then
		7926	Result := 0.75 - Sqr(Value)
		7927	else
		7928	if (Value < 1.5) then
		7929	begin
		7930	Value := Value - 1.5;
		7931	Result := 0.5 * Sqr(Value);
		7932	end
		7933	else
		7934	Result := 0.0;
		7935	end;
		7936
		7937	// B-spline filter
16	daniel-mar	7938	function SplineFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7939	var
		7940	tt: single;
		7941	begin
		7942	if (Value < 0.0) then
		7943	Value := -Value;
		7944	if (Value < 1.0) then
		7945	begin
		7946	tt := Sqr(Value);
		7947	Result := 0.5 * tt * Value - tt + 2.0 / 3.0;
		7948	end
		7949	else
		7950	if (Value < 2.0) then
		7951	begin
		7952	Value := 2.0 - Value;
		7953	Result := 1.0 / 6.0 * Sqr(Value) * Value;
		7954	end
		7955	else
		7956	Result := 0.0;
		7957	end;
		7958
		7959	// Lanczos3 filter
		7960	function Lanczos3Filter(Value: Single): Single;
16	daniel-mar	7961	function SinC(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7962	begin
		7963	if (Value <> 0.0) then
		7964	begin
		7965	Value := Value * Pi;
		7966	Result := sin(Value) / Value
		7967	end
		7968	else
		7969	Result := 1.0;
		7970	end;
		7971	begin
		7972	if (Value < 0.0) then
		7973	Value := -Value;
		7974	if (Value < 3.0) then
		7975	Result := SinC(Value) * SinC(Value / 3.0)
		7976	else
		7977	Result := 0.0;
		7978	end;
		7979
16	daniel-mar	7980	function MitchellFilter(Value: Single): Single; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	7981	const
		7982	B = (1.0 / 3.0);
		7983	C = (1.0 / 3.0);
		7984	var
		7985	tt: single;
		7986	begin
		7987	if (Value < 0.0) then
		7988	Value := -Value;
		7989	tt := Sqr(Value);
		7990	if (Value < 1.0) then
		7991	begin
		7992	Value := (((12.0 - 9.0 * B - 6.0 * C) * (Value * tt))
		7993	+ ((-18.0 + 12.0 * B + 6.0 * C) * tt)
		7994	+ (6.0 - 2 * B));
		7995	Result := Value / 6.0;
		7996	end
		7997	else
		7998	if (Value < 2.0) then
		7999	begin
		8000	Value := (((-1.0 * B - 6.0 * C) * (Value * tt))
		8001	+ ((6.0 * B + 30.0 * C) * tt)
		8002	+ ((-12.0 * B - 48.0 * C) * Value)
		8003	+ (8.0 * B + 24 * C));
		8004	Result := Value / 6.0;
		8005	end
		8006	else
		8007	Result := 0.0;
		8008	end;
		8009
		8010	// -----------------------------------------------------------------------------
		8011	//
		8012	// Interpolator
		8013	//
		8014	// -----------------------------------------------------------------------------
		8015	type
		8016	// Contributor for a pixel
16	daniel-mar	8017	TContributor = packed record
4	daniel-mar	8018	pixel: Integer; // Source pixel
		8019	weight: single; // Pixel weight
		8020	end;
		8021
		8022	TContributorList = array[0..0] of TContributor;
		8023	PContributorList = ^TContributorList;
		8024
		8025	// List of source pixels contributing to a destination pixel
16	daniel-mar	8026	TCList = packed record
4	daniel-mar	8027	n: Integer;
		8028	p: PContributorList;
		8029	end;
		8030
		8031	TCListList = array[0..0] of TCList;
		8032	PCListList = ^TCListList;
		8033
		8034	TRGB = packed record
		8035	r, g, b: single;
		8036	end;
		8037
		8038	// Physical bitmap pixel
		8039	TColorRGB = packed record
		8040	r, g, b: BYTE;
		8041	end;
		8042	PColorRGB = ^TColorRGB;
		8043
		8044	// Physical bitmap scanline (row)
		8045	TRGBList = packed array[0..0] of TColorRGB;
		8046	PRGBList = ^TRGBList;
		8047
		8048	var
		8049	xscale, yscale: single; // Zoom scale factors
		8050	i, j, k: Integer; // Loop variables
		8051	center: single; // Filter calculation variables
		8052	width, fscale, weight: single; // Filter calculation variables
		8053	left, right: Integer; // Filter calculation variables
		8054	n: Integer; // Pixel number
		8055	Work: TDIB;
		8056	contrib: PCListList;
		8057	rgb: TRGB;
		8058	color: TColorRGB;
		8059	{$IFDEF USE_SCANLINE}
		8060	SourceLine,
		8061	DestLine: PRGBList;
16	daniel-mar	8062	//SourcePixel,
4	daniel-mar	8063	DestPixel: PColorRGB;
		8064	Delta,
		8065	DestDelta: Integer;
		8066	{$ENDIF}
		8067	SrcWidth,
		8068	SrcHeight,
		8069	DstWidth,
		8070	DstHeight: Integer;
		8071
16	daniel-mar	8072	function Color2RGB(Color: TColor): TColorRGB; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	8073	begin
		8074	Result.r := Color and $000000FF;
		8075	Result.g := (Color and $0000FF00) shr 8;
		8076	Result.b := (Color and $00FF0000) shr 16;
		8077	end;
		8078
16	daniel-mar	8079	function RGB2Color(Color: TColorRGB): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	8080	begin
		8081	Result := Color.r or (Color.g shl 8) or (Color.b shl 16);
		8082	end;
		8083
		8084	begin
		8085	DstWidth := Dst.Width;
		8086	DstHeight := Dst.Height;
		8087	SrcWidth := Src.Width;
		8088	SrcHeight := Src.Height;
		8089	if (SrcWidth < 1) or (SrcHeight < 1) then
		8090	raise Exception.Create('Source bitmap too small');
		8091
		8092	// Create intermediate image to hold horizontal zoom
		8093	Work := TDIB.Create;
		8094	try
		8095	Work.Height := SrcHeight;
		8096	Work.Width := DstWidth;
		8097	// xscale := DstWidth / SrcWidth;
		8098	// yscale := DstHeight / SrcHeight;
		8099	// Improvement suggested by David Ullrich:
		8100	if (SrcWidth = 1) then
		8101	xscale := DstWidth / SrcWidth
		8102	else
		8103	xscale := (DstWidth - 1) / (SrcWidth - 1);
		8104	if (SrcHeight = 1) then
		8105	yscale := DstHeight / SrcHeight
		8106	else
		8107	yscale := (DstHeight - 1) / (SrcHeight - 1);
		8108	// This implementation only works on 24-bit images because it uses
		8109	// TDIB.Scanline
		8110	{$IFDEF USE_SCANLINE}
		8111	//Src.PixelFormat := pf24bit;
		8112	Src.BitCount := 24;
		8113	//Dst.PixelFormat := Src.PixelFormat;
		8114	dst.BitCount := 24;
		8115	//Work.PixelFormat := Src.PixelFormat;
		8116	work.BitCount := 24;
		8117	{$ENDIF}
		8118
		8119	// --------------------------------------------
		8120	// Pre-calculate filter contributions for a row
		8121	// -----------------------------------------------
		8122	GetMem(contrib, DstWidth * sizeof(TCList));
		8123	// Horizontal sub-sampling
		8124	// Scales from bigger to smaller width
		8125	if (xscale < 1.0) then
		8126	begin
		8127	width := fwidth / xscale;
		8128	fscale := 1.0 / xscale;
		8129	for i := 0 to DstWidth - 1 do
		8130	begin
		8131	contrib^[i].n := 0;
		8132	GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
		8133	center := i / xscale;
		8134	// Original code:
		8135	// left := ceil(center - width);
		8136	// right := floor(center + width);
		8137	left := floor(center - width);
		8138	right := ceil(center + width);
		8139	for j := left to right do
		8140	begin
		8141	case filtertype of
		8142	ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
		8143	ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
		8144	ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
		8145	ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
		8146	ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
		8147	ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
		8148	ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
		8149	else
		8150	weight := 0
		8151	end;
		8152	if (weight = 0.0) then
		8153	continue;
		8154	if (j < 0) then
		8155	n := -j
		8156	else if (j >= SrcWidth) then
		8157	n := SrcWidth - j + SrcWidth - 1
		8158	else
		8159	n := j;
		8160	k := contrib^[i].n;
		8161	contrib^[i].n := contrib^[i].n + 1;
		8162	contrib^[i].p^[k].pixel := n;
		8163	contrib^[i].p^[k].weight := weight;
		8164	end;
		8165	end;
		8166	end
		8167	else
		8168	// Horizontal super-sampling
		8169	// Scales from smaller to bigger width
		8170	begin
		8171	for i := 0 to DstWidth - 1 do
		8172	begin
		8173	contrib^[i].n := 0;
		8174	GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
		8175	center := i / xscale;
		8176	// Original code:
		8177	// left := ceil(center - fwidth);
		8178	// right := floor(center + fwidth);
		8179	left := floor(center - fwidth);
		8180	right := ceil(center + fwidth);
		8181	for j := left to right do
		8182	begin
		8183	case filtertype of
		8184	ftrBox: weight := boxfilter(center - j);
		8185	ftrTriangle: weight := trianglefilter(center - j);
		8186	ftrHermite: weight := hermitefilter(center - j);
		8187	ftrBell: weight := bellfilter(center - j);
		8188	ftrBSpline: weight := splinefilter(center - j);
		8189	ftrLanczos3: weight := Lanczos3filter(center - j);
		8190	ftrMitchell: weight := Mitchellfilter(center - j);
		8191	else
		8192	weight := 0
		8193	end;
		8194	if (weight = 0.0) then
		8195	continue;
		8196	if (j < 0) then
		8197	n := -j
		8198	else if (j >= SrcWidth) then
		8199	n := SrcWidth - j + SrcWidth - 1
		8200	else
		8201	n := j;
		8202	k := contrib^[i].n;
		8203	contrib^[i].n := contrib^[i].n + 1;
		8204	contrib^[i].p^[k].pixel := n;
		8205	contrib^[i].p^[k].weight := weight;
		8206	end;
		8207	end;
		8208	end;
		8209
		8210	// ----------------------------------------------------
		8211	// Apply filter to sample horizontally from Src to Work
		8212	// ----------------------------------------------------
		8213	for k := 0 to SrcHeight - 1 do
		8214	begin
		8215	{$IFDEF USE_SCANLINE}
		8216	SourceLine := Src.ScanLine[k];
		8217	DestPixel := Work.ScanLine[k];
		8218	{$ENDIF}
		8219	for i := 0 to DstWidth - 1 do
		8220	begin
		8221	rgb.r := 0.0;
		8222	rgb.g := 0.0;
		8223	rgb.b := 0.0;
		8224	for j := 0 to contrib^[i].n - 1 do
		8225	begin
		8226	{$IFDEF USE_SCANLINE}
		8227	color := SourceLine^[contrib^[i].p^[j].pixel];
		8228	{$ELSE}
		8229	color := Color2RGB(Src.Canvas.Pixels[contrib^[i].p^[j].pixel, k]);
		8230	{$ENDIF}
		8231	weight := contrib^[i].p^[j].weight;
		8232	if (weight = 0.0) then
		8233	continue;
		8234	rgb.r := rgb.r + color.r * weight;
		8235	rgb.g := rgb.g + color.g * weight;
		8236	rgb.b := rgb.b + color.b * weight;
		8237	end;
		8238	if (rgb.r > 255.0) then
		8239	color.r := 255
		8240	else if (rgb.r < 0.0) then
		8241	color.r := 0
		8242	else
		8243	color.r := round(rgb.r);
		8244	if (rgb.g > 255.0) then
		8245	color.g := 255
		8246	else if (rgb.g < 0.0) then
		8247	color.g := 0
		8248	else
		8249	color.g := round(rgb.g);
		8250	if (rgb.b > 255.0) then
		8251	color.b := 255
		8252	else if (rgb.b < 0.0) then
		8253	color.b := 0
		8254	else
		8255	color.b := round(rgb.b);
		8256	{$IFDEF USE_SCANLINE}
		8257	// Set new pixel value
		8258	DestPixel^ := color;
		8259	// Move on to next column
		8260	inc(DestPixel);
		8261	{$ELSE}
		8262	Work.Canvas.Pixels[i, k] := RGB2Color(color);
		8263	{$ENDIF}
		8264	end;
		8265	end;
		8266
		8267	// Free the memory allocated for horizontal filter weights
		8268	for i := 0 to DstWidth - 1 do
		8269	FreeMem(contrib^[i].p);
		8270
		8271	FreeMem(contrib);
		8272
		8273	// -----------------------------------------------
		8274	// Pre-calculate filter contributions for a column
		8275	// -----------------------------------------------
		8276	GetMem(contrib, DstHeight * sizeof(TCList));
		8277	// Vertical sub-sampling
		8278	// Scales from bigger to smaller height
		8279	if (yscale < 1.0) then
		8280	begin
		8281	width := fwidth / yscale;
		8282	fscale := 1.0 / yscale;
		8283	for i := 0 to DstHeight - 1 do
		8284	begin
		8285	contrib^[i].n := 0;
		8286	GetMem(contrib^[i].p, trunc(width * 2.0 + 1) * sizeof(TContributor));
		8287	center := i / yscale;
		8288	// Original code:
		8289	// left := ceil(center - width);
		8290	// right := floor(center + width);
		8291	left := floor(center - width);
		8292	right := ceil(center + width);
		8293	for j := left to right do
		8294	begin
		8295	case filtertype of
		8296	ftrBox: weight := boxfilter((center - j) / fscale) / fscale;
		8297	ftrTriangle: weight := trianglefilter((center - j) / fscale) / fscale;
		8298	ftrHermite: weight := hermitefilter((center - j) / fscale) / fscale;
		8299	ftrBell: weight := bellfilter((center - j) / fscale) / fscale;
		8300	ftrBSpline: weight := splinefilter((center - j) / fscale) / fscale;
		8301	ftrLanczos3: weight := Lanczos3filter((center - j) / fscale) / fscale;
		8302	ftrMitchell: weight := Mitchellfilter((center - j) / fscale) / fscale;
		8303	else
		8304	weight := 0
		8305	end;
		8306	if (weight = 0.0) then
		8307	continue;
		8308	if (j < 0) then
		8309	n := -j
		8310	else if (j >= SrcHeight) then
		8311	n := SrcHeight - j + SrcHeight - 1
		8312	else
		8313	n := j;
		8314	k := contrib^[i].n;
		8315	contrib^[i].n := contrib^[i].n + 1;
		8316	contrib^[i].p^[k].pixel := n;
		8317	contrib^[i].p^[k].weight := weight;
		8318	end;
		8319	end
		8320	end
		8321	else
		8322	// Vertical super-sampling
		8323	// Scales from smaller to bigger height
		8324	begin
		8325	for i := 0 to DstHeight - 1 do
		8326	begin
		8327	contrib^[i].n := 0;
		8328	GetMem(contrib^[i].p, trunc(fwidth * 2.0 + 1) * sizeof(TContributor));
		8329	center := i / yscale;
		8330	// Original code:
		8331	// left := ceil(center - fwidth);
		8332	// right := floor(center + fwidth);
		8333	left := floor(center - fwidth);
		8334	right := ceil(center + fwidth);
		8335	for j := left to right do
		8336	begin
		8337	case filtertype of
		8338	ftrBox: weight := boxfilter(center - j);
		8339	ftrTriangle: weight := trianglefilter(center - j);
		8340	ftrHermite: weight := hermitefilter(center - j);
		8341	ftrBell: weight := bellfilter(center - j);
		8342	ftrBSpline: weight := splinefilter(center - j);
		8343	ftrLanczos3: weight := Lanczos3filter(center - j);
		8344	ftrMitchell: weight := Mitchellfilter(center - j);
		8345	else
		8346	weight := 0
		8347	end;
		8348	if (weight = 0.0) then
		8349	continue;
		8350	if (j < 0) then
		8351	n := -j
		8352	else if (j >= SrcHeight) then
		8353	n := SrcHeight - j + SrcHeight - 1
		8354	else
		8355	n := j;
		8356	k := contrib^[i].n;
		8357	contrib^[i].n := contrib^[i].n + 1;
		8358	contrib^[i].p^[k].pixel := n;
		8359	contrib^[i].p^[k].weight := weight;
		8360	end;
		8361	end;
		8362	end;
		8363
		8364	// --------------------------------------------------
		8365	// Apply filter to sample vertically from Work to Dst
		8366	// --------------------------------------------------
		8367	{$IFDEF USE_SCANLINE}
		8368	SourceLine := Work.ScanLine[0];
		8369	Delta := Integer(Work.ScanLine[1]) - Integer(SourceLine);
		8370	DestLine := Dst.ScanLine[0];
		8371	DestDelta := Integer(Dst.ScanLine[1]) - Integer(DestLine);
		8372	{$ENDIF}
		8373	for k := 0 to DstWidth - 1 do
		8374	begin
		8375	{$IFDEF USE_SCANLINE}
		8376	DestPixel := pointer(DestLine);
		8377	{$ENDIF}
		8378	for i := 0 to DstHeight - 1 do
		8379	begin
		8380	rgb.r := 0;
		8381	rgb.g := 0;
		8382	rgb.b := 0;
		8383	// weight := 0.0;
		8384	for j := 0 to contrib^[i].n - 1 do
		8385	begin
		8386	{$IFDEF USE_SCANLINE}
16	daniel-mar	8387	//color := PColorRGB(PByte(SourceLine) + contrib^[i].p^[j].pixel * Delta)^;
		8388	Move(Pointer(Integer(SourceLine) + contrib^[i].p^[j].pixel * Delta)^, Color, SizeOf(Color));
4	daniel-mar	8389	{$ELSE}
		8390	color := Color2RGB(Work.Canvas.Pixels[k, contrib^[i].p^[j].pixel]);
		8391	{$ENDIF}
		8392	weight := contrib^[i].p^[j].weight;
		8393	if (weight = 0.0) then
		8394	continue;
		8395	rgb.r := rgb.r + color.r * weight;
		8396	rgb.g := rgb.g + color.g * weight;
		8397	rgb.b := rgb.b + color.b * weight;
		8398	end;
		8399	if (rgb.r > 255.0) then
		8400	color.r := 255
		8401	else if (rgb.r < 0.0) then
		8402	color.r := 0
		8403	else
		8404	color.r := round(rgb.r);
		8405	if (rgb.g > 255.0) then
		8406	color.g := 255
		8407	else if (rgb.g < 0.0) then
		8408	color.g := 0
		8409	else
		8410	color.g := round(rgb.g);
		8411	if (rgb.b > 255.0) then
		8412	color.b := 255
		8413	else if (rgb.b < 0.0) then
		8414	color.b := 0
		8415	else
		8416	color.b := round(rgb.b);
		8417	{$IFDEF USE_SCANLINE}
		8418	DestPixel^ := color;
16	daniel-mar	8419	{$IFDEF WIN64}
		8420	inc(PByte(DestPixel), DestDelta);
		8421	{$ELSE}
4	daniel-mar	8422	inc(Integer(DestPixel), DestDelta);
16	daniel-mar	8423	{$ENDIF}
4	daniel-mar	8424	{$ELSE}
		8425	Dst.Canvas.Pixels[k, i] := RGB2Color(color);
		8426	{$ENDIF}
		8427	end;
		8428	{$IFDEF USE_SCANLINE}
		8429	Inc(SourceLine, 1);
		8430	Inc(DestLine, 1);
		8431	{$ENDIF}
		8432	end;
		8433
		8434	// Free the memory allocated for vertical filter weights
		8435	for i := 0 to DstHeight - 1 do
		8436	FreeMem(contrib^[i].p);
		8437
		8438	FreeMem(contrib);
		8439
		8440	finally
		8441	Work.Free;
		8442	end;
		8443	end;
		8444	var BB1, BB2: TDIB;
		8445	begin
		8446	BB1 := TDIB.Create;
		8447	BB1.BitCount := 24;
		8448	BB1.Assign(Self);
		8449	BB2 := TDIB.Create;
		8450	BB2.SetSize(AmountX, AmountY, 24);
		8451	Resample(BB1, BB2, TypeResample, DefaultFilterRadius[TypeResample]);
		8452	Self.Assign(BB2);
		8453	BB1.Free;
		8454	BB2.Free;
		8455	end;
		8456
		8457	procedure TDIB.DoColorize(ForeColor, BackColor: TColor);
		8458	procedure Colorize(src, dst: TDIB; iForeColor, iBackColor: TColor; iDither: Boolean{$IFDEF VER4UP} = False{$ENDIF});
		8459	{for monochromatic picture change colors}
		8460	procedure InvertBitmap(Bmp: TDIB);
		8461	begin
		8462	Bmp.Canvas.CopyMode := cmDstInvert;
		8463	Bmp.Canvas.CopyRect(rect(0, 0, Bmp.Width, Bmp.Height),
		8464	Bmp.Canvas, rect(0, 0, Bmp.Width, Bmp.Height));
		8465	end;
		8466	var
		8467	fForeColor: TColor;
		8468	fForeDither: Boolean;
		8469	lTempBitmap: TDIB;
		8470	lTempBitmap2: TDIB;
		8471	lDitherBitmap: TDIB;
		8472	lCRect: TRect;
		8473	x, y, w, h: Integer;
		8474	begin
		8475	{--}
		8476	//fColor := iBackColor; ;
		8477	fForeColor := iForeColor;
		8478	fForeDither := iDither;
		8479	w := src.Width;
		8480	h := src.Height;
		8481	lDitherBitmap := nil;
		8482	lTempBitmap := TDIB.Create;
		8483	lTempBitmap.SetSize(w, h, 24);
		8484	lTempBitmap2 := TDIB.Create;
		8485	lTempBitmap2.SetSize(w, h, 24);
		8486	lCRect := rect(0, 0, w, h);
		8487	with lTempBitmap.Canvas do
		8488	begin
		8489	Brush.Style := bsSolid;
		8490	Brush.Color := iBackColor;
		8491	FillRect(lCRect);
		8492	CopyMode := cmSrcInvert;
		8493	CopyRect(lCRect, src.Canvas, lCRect);
		8494	InvertBitmap(src);
		8495	CopyMode := cmSrcPaint;
		8496	CopyRect(lCRect, src.Canvas, lCRect);
		8497	InvertBitmap(lTempBitmap);
		8498	CopyMode := cmSrcInvert;
		8499	CopyRect(lCRect, src.Canvas, lCRect);
		8500	InvertBitmap(src);
		8501	end;
		8502	with lTempBitmap2.Canvas do
		8503	begin
		8504	Brush.Style := bsSolid;
		8505	Brush.Color := clBlack;
		8506	FillRect(lCRect);
		8507	if fForeDither then
		8508	begin
		8509	InvertBitmap(src);
		8510	lDitherBitmap := TDIB.Create;
		8511	lDitherBitmap.SetSize(8, 8, 24);
		8512	with lDitherBitmap.Canvas do
		8513	begin
		8514	for x := 0 to 7 do
		8515	for y := 0 to 7 do
		8516	if ((x mod 2 = 0) and (y mod 2 > 0)) or ((x mod 2 > 0) and (y mod 2 = 0)) then
		8517	pixels[x, y] := fForeColor
		8518	else
		8519	pixels[x, y] := iBackColor;
		8520	end;
		8521	Brush.Bitmap.Assign(lDitherBitmap);
		8522	end
		8523	else
		8524	begin
		8525	Brush.Style := bsSolid;
		8526	Brush.Color := fForeColor;
		8527	end;
		8528	if not fForeDither then
		8529	InvertBitmap(src);
		8530	CopyMode := cmPatPaint;
		8531	CopyRect(lCRect, src.Canvas, lCRect);
		8532	if fForeDither then
		8533	if Assigned(lDitherBitmap) then
		8534	lDitherBitmap.Free;
		8535	CopyMode := cmSrcInvert;
		8536	CopyRect(lCRect, src.Canvas, lCRect);
		8537	end;
		8538	lTempBitmap.Canvas.CopyMode := cmSrcInvert;
		8539	lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
		8540	InvertBitmap(src);
		8541	lTempBitmap.Canvas.CopyMode := cmSrcErase;
		8542	lTempBitmap.Canvas.Copyrect(lCRect, src.Canvas, lCRect);
		8543	InvertBitmap(src);
		8544	lTempBitmap.Canvas.CopyMode := cmSrcInvert;
		8545	lTempBitmap.Canvas.Copyrect(lCRect, lTempBitmap2.Canvas, lCRect);
		8546	InvertBitmap(lTempBitmap);
		8547	InvertBitmap(src);
		8548	dst.Assign(lTempBitmap);
		8549	lTempBitmap.Free;
		8550	end;
		8551	var BB1, BB2: TDIB;
		8552	begin
		8553	BB1 := TDIB.Create;
		8554	BB1.BitCount := 24;
		8555	BB1.Assign(Self);
		8556	BB2 := TDIB.Create;
		8557	Colorize(BB1, BB2, ForeColor, BackColor{$IFNDEF VER4UP}, False{$ENDIF});
		8558	Self.Assign(BB2);
		8559	BB1.Free;
		8560	BB2.Free;
		8561	end;
		8562
		8563	{ procedure for special purpose }
16	daniel-mar	8564	(*
4	daniel-mar	8565	procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte);
		8566	var
		8567	P1, P2: PByteArray;
		8568	W, H: Integer;
		8569	begin
		8570	P1 := ScanLine[DIB2.Height - 1];
		8571	P2 := DIB2.ScanLine[DIB2.Height - 1];
		8572	W := WidthBytes;
		8573	H := Height;
		8574	asm
		8575	PUSH ESI
		8576	PUSH EDI
		8577	MOV ESI, P1
		8578	MOV EDI, P2
		8579	MOV EDX, W
		8580	MOV EAX, H
		8581	IMUL EDX
		8582	MOV ECX, EAX
		8583	@@1:
		8584	MOV AL, Step
		8585	MOV AH, [ESI]
		8586	CMP AL, AH
		8587	JA @@2
		8588	MOV AL, AH
		8589	@@2:
		8590	MOV [EDI], AL
		8591	INC ESI
		8592	INC EDI
		8593	DEC ECX
		8594	JNZ @@1
		8595	POP EDI
		8596	POP ESI
		8597	end;
		8598	end;
16	daniel-mar	8599	*)
		8600	procedure TDIB.FadeOut(DIB2: TDIB; Step: Byte);
		8601	var
		8602	P1, P2: PByteArray;
		8603	W, H, i: Integer;
		8604	begin
		8605	P1 := ScanLine[DIB2.Height - 1];
		8606	P2 := DIB2.ScanLine[DIB2.Height - 1];
		8607	W := WidthBytes;
		8608	H := Height;
		8609	for i := 0 to W * H - 1 do
		8610	begin
		8611	if P1[i] < Step then P2[i] := P1[i]
		8612	else P2[i] := Step;
		8613	end;
		8614	end;
4	daniel-mar	8615
		8616	procedure TDIB.DoZoom(DIB2: TDIB; ZoomRatio: Real);
		8617	var
		8618	P1, P2: PByteArray;
		8619	W, H: Integer;
		8620	x, y: Integer;
		8621	xr, yr, xstep, ystep: real;
		8622	xstart: real;
		8623	begin
		8624	W := WidthBytes;
		8625	H := Height;
		8626	xstart := (W - (W * ZoomRatio)) / 2;
		8627
		8628	xr := xstart;
		8629	yr := (H - (H * ZoomRatio)) / 2;
		8630	xstep := ZoomRatio;
		8631	ystep := ZoomRatio;
		8632
		8633	for y := 1 to Height - 1 do
		8634	begin
		8635	P2 := DIB2.ScanLine[y];
		8636	if (yr >= 0) and (yr <= H) then
		8637	begin
		8638	P1 := ScanLine[Trunc(yr)];
		8639	for x := 1 to Width - 1 do
		8640	begin
		8641	if (xr >= 0) and (xr <= W) then
		8642	begin
		8643	P2[x] := P1[Trunc(xr)];
		8644	end
		8645	else
		8646	begin
		8647	P2[x] := 0;
		8648	end;
		8649	xr := xr + xstep;
		8650	end;
		8651	end
		8652	else
		8653	begin
		8654	for x := 1 to Width - 1 do
		8655	begin
		8656	P2[x] := 0;
		8657	end;
		8658	end;
		8659	xr := xstart;
		8660	yr := yr + ystep;
		8661	end;
		8662	end;
		8663
		8664	procedure TDIB.DoBlur(DIB2: TDIB);
		8665	var
		8666	P1, P2: PByteArray;
		8667	W: Integer;
		8668	x, y: Integer;
		8669	begin
		8670	W := WidthBytes;
		8671	for y := 1 to Height - 1 do
		8672	begin
		8673	P1 := ScanLine[y];
		8674	P2 := DIB2.ScanLine[y];
		8675	for x := 1 to Width - 1 do
		8676	begin
		8677	P2[x] := (P1[x] + P1[x - 1] + P1[x + 1] + P1[x + W] + P1[x - W]) div 5;
		8678	end;
		8679	end;
		8680	end;
16	daniel-mar	8681	(*
4	daniel-mar	8682	procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte);
		8683	var
		8684	P1, P2: PByteArray;
		8685	W, H: Integer;
		8686	begin
		8687	P1 := ScanLine[DIB2.Height - 1];
		8688	P2 := DIB2.ScanLine[DIB2.Height - 1];
		8689	W := WidthBytes;
		8690	H := Height;
		8691	asm
		8692	PUSH ESI
		8693	PUSH EDI
		8694	MOV ESI, P1
		8695	MOV EDI, P2
		8696	MOV EDX, W
		8697	MOV EAX, H
		8698	IMUL EDX
		8699	MOV ECX, EAX
		8700	@@1:
		8701	MOV AL, Step
		8702	MOV AH, [ESI]
		8703	CMP AL, AH
		8704	JB @@2
		8705	MOV AL, AH
		8706	@@2:
		8707	MOV [EDI], AL
		8708	INC ESI
		8709	INC EDI
		8710	DEC ECX
		8711	JNZ @@1
		8712	POP EDI
		8713	POP ESI
		8714	end;
		8715	end;
16	daniel-mar	8716	*)
		8717	procedure TDIB.FadeIn(DIB2: TDIB; Step: Byte);
		8718	var
		8719	P1, P2: PByteArray;
		8720	W, H, i: Integer;
		8721	begin
		8722	P1 := ScanLine[DIB2.Height - 1];
		8723	P2 := DIB2.ScanLine[DIB2.Height - 1];
		8724	W := WidthBytes;
		8725	H := Height;
		8726	for i := 0 to W * H - 1 do
		8727	begin
		8728	if P1[i] > Step then P2[i] := P1[i]
		8729	else P2[i] := Step;
		8730	end;
		8731	end;
4	daniel-mar	8732
16	daniel-mar	8733	(*
4	daniel-mar	8734	procedure TDIB.FillDIB8(Color: Byte);
		8735	var
		8736	P: PByteArray;
		8737	W, H: Integer;
		8738	begin
		8739	P := ScanLine[Height - 1];
		8740	W := WidthBytes;
		8741	H := Height;
		8742	asm
		8743	PUSH ESI
		8744	MOV ESI, P
		8745	MOV EDX, W
		8746	MOV EAX, H
		8747	IMUL EDX
		8748	MOV ECX, EAX
		8749	MOV AL, Color
		8750	@@1:
		8751	MOV [ESI], AL
		8752	INC ESI
		8753	DEC ECX
		8754	JNZ @@1
		8755	POP ESI
		8756	end;
		8757	end;
16	daniel-mar	8758	*)
4	daniel-mar	8759
16	daniel-mar	8760	procedure TDIB.FillDIB8(Color: Byte);
		8761	var
		8762	P: PByteArray;
		8763	W, H, I: Integer;
		8764	begin
		8765	P := ScanLine[Height - 1];
		8766	W := WidthBytes;
		8767	H := Height;
		8768	for I := 0 to W * H - 1 do
		8769	P[I] := Color;
		8770	end;
		8771
		8772
4	daniel-mar	8773	procedure TDIB.DoRotate(DIB1: TDIB; cX, cY, Angle: Integer);
		8774	type
		8775	T3Byte = array[0..2] of Byte;
		8776	P3ByteArray = ^T3ByteArray;
		8777	T3ByteArray = array[0..32767] of T3Byte;
		8778	PLongArray = ^TLongArray;
		8779	TLongArray = array[0..32767] of LongInt;
		8780	var
		8781	p, p2: PByteArray;
		8782	x, y, x2, y2, angled: Integer;
		8783	cosy, siny: real;
		8784	begin
		8785	angled := 384 + Angle;
		8786	for y := 0 to Height - 1 do
		8787	begin
		8788	p := DIB1.ScanLine[y];
		8789	cosy := (y - cY) * dcos(angled and $1FF);
		8790	siny := (y - cY) * dsin(angled and $1FF);
		8791	for x := 0 to Width - 1 do
		8792	begin
		8793	x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
		8794	y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
		8795	case bitcount of
		8796	8:
		8797	begin
		8798	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		8799	begin
		8800	p2 := ScanLine[y2];
		8801	p[x] := p2[Width - x2];
		8802	end
		8803	else
		8804	begin
		8805	if p[x] > 4 then
		8806	p[x] := p[x] - 4
		8807	else
		8808	p[x] := 0;
		8809	end;
		8810	end;
		8811	16:
		8812	begin
		8813	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		8814	begin
		8815	PWordArray(p2) := ScanLine[y2];
		8816	PWordArray(p)[x] := PWordArray(p2)[Width - x2];
		8817	end
		8818	else
		8819	begin
		8820	if PWordArray(p)[x] > 4 then
		8821	PWordArray(p)[x] := PWordArray(p)[x] - 4
		8822	else
		8823	PWordArray(p)[x] := 0;
		8824	end;
		8825	end;
		8826	24:
		8827	begin
		8828	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		8829	begin
		8830	P3ByteArray(p2) := ScanLine[y2];
		8831	P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
		8832	end
		8833	else
		8834	begin
		8835	if P3ByteArray(p)[x][0] > 4 then
		8836	P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 4
		8837	else if P3ByteArray(p)[x][1] > 4 then
		8838	P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 4
		8839	else if P3ByteArray(p)[x][2] > 4 then
		8840	P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 4
		8841	else
		8842	begin
		8843	P3ByteArray(p)[x][0] := 0;
		8844	P3ByteArray(p)[x][1] := 0;
		8845	P3ByteArray(p)[x][2] := 0;
		8846	end;
		8847	end;
		8848	end;
		8849	32: begin
		8850	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		8851	begin
		8852	plongarray(p2) := ScanLine[y2];
		8853	plongarray(p)[x] := plongarray(p2)[Width - x2];
		8854	end
		8855	else
		8856	begin
		8857	if plongarray(p)[x] > 4 then
		8858	plongarray(p)[x] := plongarray(p)[x] - 4
		8859	else
		8860	plongarray(p)[x] := 0;
		8861	end;
		8862	end;
		8863	end
		8864	end;
		8865	end;
		8866	end;
		8867
		8868	function TDIB.Ink(DIB: TDIB; const SprayInit: Boolean; const AmountSpray: Integer): Boolean;
		8869	type
		8870	T3Byte = array[0..2] of Byte;
		8871	P3ByteArray = ^T3ByteArray;
		8872	T3ByteArray = array[0..32767] of T3Byte;
		8873	PLongArray = ^TLongArray;
		8874	TLongArray = array[0..32767] of LongInt;
		8875	function ColorToRGBTriple(const Color: TColor): TRGBTriple;
		8876	begin
		8877	with RESULT do
		8878	begin
		8879	rgbtRed := GetRValue(Color);
		8880	rgbtGreen := GetGValue(Color);
		8881	rgbtBlue := GetBValue(Color)
		8882	end
		8883	end {ColorToRGBTriple};
		8884
		8885	function TestQuad(T: T3Byte; Color: Integer): Boolean;
		8886	begin
		8887	Result := (T[0] > GetRValue(Color)) and
		8888	(T[1] > GetGValue(Color)) and
		8889	(T[2] > GetBValue(Color))
		8890	end;
		8891	var
		8892	p0, p, p2: PByteArray;
		8893	x, y, c: Integer;
		8894	z: Integer;
		8895	begin
		8896	if SprayInit then
		8897	begin
		8898	DIB.Assign(Self);
		8899	{ Spray seeds }
		8900	for c := 0 to AmountSpray do
		8901	begin
		8902	DIB.Pixels[Random(Width - 1), Random(Height - 1)] := 0;
		8903	end;
		8904	end;
		8905	Result := True; {all is black}
		8906	for y := 0 to DIB.Height - 1 do
		8907	begin
		8908	p := DIB.ScanLine[y];
		8909	for x := 0 to DIB.Width - 1 do
		8910	begin
		8911	case bitcount of
		8912	8:
		8913	begin
		8914	if p[x] < 16 then
		8915	begin
		8916	if p[x] > 0 then Result := False;
		8917	if y > 0 then
		8918	begin
		8919	p0 := DIB.ScanLine[y - 1];
		8920	if p0[x] > 4 then
		8921	p0[x] := p0[x] - 4
		8922	else
		8923	p0[x] := 0;
		8924	if x > 0 then
		8925	if p0[x - 1] > 2 then
		8926	p0[x - 1] := p0[x - 1] - 2
		8927	else
		8928	p0[x - 1] := 0;
		8929	if x < (DIB.Width - 1) then
		8930	if p0[x + 1] > 2 then
		8931	p0[x + 1] := p0[x + 1] - 2
		8932	else
		8933	p0[x + 1] := 0;
		8934	end;
		8935	if y < (DIB.Height - 1) then
		8936	begin
		8937	p2 := DIB.ScanLine[y + 1];
		8938	if p2[x] > 4 then
		8939	p2[x] := p2[x] - 4
		8940	else
		8941	p2[x] := 0;
		8942	if x > 0 then
		8943	if p2[x - 1] > 2 then
		8944	p2[x - 1] := p2[x - 1] - 2
		8945	else
		8946	p2[x - 1] := 0;
		8947	if x < (DIB.Width - 1) then
		8948	if p2[x + 1] > 2 then
		8949	p2[x + 1] := p2[x + 1] - 2
		8950	else
		8951	p2[x + 1] := 0;
		8952	end;
		8953	if p[x] > 8 then
		8954	p[x] := p[x] - 8
		8955	else
		8956	p[x] := 0;
		8957	if x > 0 then
		8958	if p[x - 1] > 4 then
		8959	p[x - 1] := p[x - 1] - 4
		8960	else
		8961	p[x - 1] := 0;
		8962	if x < (DIB.Width - 1) then
		8963	if p[x + 1] > 4 then
		8964	p[x + 1] := p[x + 1] - 4
		8965	else
		8966	p[x + 1] := 0;
		8967	end;
		8968	end;
		8969	16:
		8970	begin
		8971	if pwordarray(p)[x] < 16 then
		8972	begin
		8973	if pwordarray(p)[x] > 0 then Result := False;
		8974	if y > 0 then
		8975	begin
		8976	pwordarray(p0) := DIB.ScanLine[y - 1];
		8977	if pwordarray(p0)[x] > 4 then
		8978	pwordarray(p0)[x] := pwordarray(p0)[x] - 4
		8979	else
		8980	pwordarray(p0)[x] := 0;
		8981	if x > 0 then
		8982	if pwordarray(p0)[x - 1] > 2 then
		8983	pwordarray(p0)[x - 1] := pwordarray(p0)[x - 1] - 2
		8984	else
		8985	pwordarray(p0)[x - 1] := 0;
		8986	if x < (DIB.Width - 1) then
		8987	if pwordarray(p0)[x + 1] > 2 then
		8988	pwordarray(p0)[x + 1] := pwordarray(p0)[x + 1] - 2
		8989	else
		8990	pwordarray(p0)[x + 1] := 0;
		8991	end;
		8992	if y < (DIB.Height - 1) then
		8993	begin
		8994	pwordarray(p2) := DIB.ScanLine[y + 1];
		8995	if pwordarray(p2)[x] > 4 then
		8996	pwordarray(p2)[x] := pwordarray(p2)[x] - 4
		8997	else
		8998	pwordarray(p2)[x] := 0;
		8999	if x > 0 then
		9000	if pwordarray(p2)[x - 1] > 2 then
		9001	pwordarray(p2)[x - 1] := pwordarray(p2)[x - 1] - 2
		9002	else
		9003	pwordarray(p2)[x - 1] := 0;
		9004	if x < (DIB.Width - 1) then
		9005	if pwordarray(p2)[x + 1] > 2 then
		9006	pwordarray(p2)[x + 1] := pwordarray(p2)[x + 1] - 2
		9007	else
		9008	pwordarray(p2)[x + 1] := 0;
		9009	end;
		9010	if pwordarray(p)[x] > 8 then
		9011	pwordarray(p)[x] := pwordarray(p)[x] - 8
		9012	else
		9013	pwordarray(p)[x] := 0;
		9014	if x > 0 then
		9015	if pwordarray(p)[x - 1] > 4 then
		9016	pwordarray(p)[x - 1] := pwordarray(p)[x - 1] - 4
		9017	else
		9018	pwordarray(p)[x - 1] := 0;
		9019	if x < (DIB.Width - 1) then
		9020	if pwordarray(p)[x + 1] > 4 then
		9021	pwordarray(p)[x + 1] := pwordarray(p)[x + 1] - 4
		9022	else
		9023	pwordarray(p)[x + 1] := 0;
		9024	end;
		9025	end;
		9026	24:
		9027	begin
		9028	if not TestQuad(P3ByteArray(p)[x], 16) then
		9029	begin
		9030	if TestQuad(P3ByteArray(p)[x], 0) then Result := False;
		9031	if y > 0 then
		9032	begin
		9033	P3ByteArray(p0) := DIB.ScanLine[y - 1];
		9034	if TestQuad(P3ByteArray(p0)[x], 4) then
		9035	begin
		9036	for z := 0 to 2 do
		9037	if P3ByteArray(p0)[x][z] > 4 then
		9038	P3ByteArray(p0)[x][z] := P3ByteArray(p0)[x][z] - 4
		9039	end
		9040	else
		9041	for z := 0 to 2 do
		9042	P3ByteArray(p0)[x][z] := 0;
		9043	if x > 0 then
		9044	if TestQuad(P3ByteArray(p0)[x - 1], 2) then
		9045	begin
		9046	for z := 0 to 2 do
		9047	if P3ByteArray(p0)[x - 1][z] > 2 then
		9048	P3ByteArray(p0)[x - 1][z] := P3ByteArray(p0)[x - 1][z] - 2
		9049	end
		9050	else
		9051	for z := 0 to 2 do
		9052	P3ByteArray(p0)[x - 1][z] := 0;
		9053	if x < (DIB.Width - 1) then
		9054	if TestQuad(P3ByteArray(p0)[x + 1], 2) then
		9055	begin
		9056	for z := 0 to 2 do
		9057	if P3ByteArray(p0)[x + 1][z] > 2 then
		9058	P3ByteArray(p0)[x + 1][z] := P3ByteArray(p0)[x + 1][z] - 2
		9059	end
		9060	else
		9061	for z := 0 to 2 do
		9062	P3ByteArray(p0)[x + 1][z] := 0;
		9063	end;
		9064	if y < (DIB.Height - 1) then
		9065	begin
		9066	P3ByteArray(p2) := DIB.ScanLine[y + 1];
		9067	if TestQuad(P3ByteArray(p2)[x], 4) then
		9068	begin
		9069	for z := 0 to 2 do
		9070	if P3ByteArray(p2)[x][z] > 4 then
		9071	P3ByteArray(p2)[x][z] := P3ByteArray(p2)[x][z] - 4
		9072	end
		9073	else
		9074	for z := 0 to 2 do
		9075	P3ByteArray(p2)[x][z] := 0;
		9076	if x > 0 then
		9077	if TestQuad(P3ByteArray(p2)[x - 1], 2) then
		9078	begin
		9079	for z := 0 to 2 do
		9080	if P3ByteArray(p2)[x - 1][z] > 2 then
		9081	P3ByteArray(p2)[x - 1][z] := P3ByteArray(p2)[x - 1][z] - 2
		9082	end
		9083	else
		9084	for z := 0 to 2 do
		9085	P3ByteArray(p2)[x - 1][z] := 0;
		9086	if x < (DIB.Width - 1) then
		9087	if TestQuad(P3ByteArray(p2)[x + 1], 2) then
		9088	begin
		9089	for z := 0 to 2 do
		9090	if P3ByteArray(p2)[x + 1][z] > 2 then
		9091	P3ByteArray(p2)[x + 1][z] := P3ByteArray(p2)[x + 1][z] - 2
		9092	end
		9093	else
		9094	for z := 0 to 2 do
		9095	P3ByteArray(p2)[x + 1][z] := 0;
		9096	end;
		9097	if TestQuad(P3ByteArray(p)[x], 8) then
		9098	begin
		9099	for z := 0 to 2 do
		9100	if P3ByteArray(p)[x][z] > 8 then
		9101	P3ByteArray(p)[x][z] := P3ByteArray(p)[x][z] - 8
		9102	end
		9103	else
		9104	for z := 0 to 2 do
		9105	P3ByteArray(p)[x][z] := 0;
		9106	if x > 0 then
		9107	if TestQuad(P3ByteArray(p)[x - 1], 4) then
		9108	begin
		9109	for z := 0 to 2 do
		9110	if P3ByteArray(p)[x - 1][z] > 4 then
		9111	P3ByteArray(p)[x - 1][z] := P3ByteArray(p)[x - 1][z] - 4
		9112	end
		9113	else
		9114	for z := 0 to 2 do
		9115	P3ByteArray(p)[x - 1][z] := 0;
		9116	if x < (DIB.Width - 1) then
		9117	if TestQuad(P3ByteArray(p)[x + 1], 4) then
		9118	begin
		9119	for z := 0 to 2 do
		9120	if P3ByteArray(p)[x + 1][z] > 4 then
		9121	P3ByteArray(p)[x + 1][z] := P3ByteArray(p)[x + 1][z] - 4
		9122	end
		9123	else
		9124	for z := 0 to 2 do
		9125	P3ByteArray(p)[x + 1][z] := 0;
		9126	end;
		9127	end;
		9128	32:
		9129	begin
		9130	if plongarray(p)[x] < 16 then
		9131	begin
		9132	if plongarray(p)[x] > 0 then Result := False;
		9133	if y > 0 then
		9134	begin
		9135	plongarray(p0) := DIB.ScanLine[y - 1];
		9136	if plongarray(p0)[x] > 4 then
		9137	plongarray(p0)[x] := plongarray(p0)[x] - 4
		9138	else
		9139	plongarray(p0)[x] := 0;
		9140	if x > 0 then
		9141	if plongarray(p0)[x - 1] > 2 then
		9142	plongarray(p0)[x - 1] := plongarray(p0)[x - 1] - 2
		9143	else
		9144	plongarray(p0)[x - 1] := 0;
		9145	if x < (DIB.Width - 1) then
		9146	if plongarray(p0)[x + 1] > 2 then
		9147	plongarray(p0)[x + 1] := plongarray(p0)[x + 1] - 2
		9148	else
		9149	plongarray(p0)[x + 1] := 0;
		9150	end;
		9151	if y < (DIB.Height - 1) then
		9152	begin
		9153	plongarray(p2) := DIB.ScanLine[y + 1];
		9154	if plongarray(p2)[x] > 4 then
		9155	plongarray(p2)[x] := plongarray(p2)[x] - 4
		9156	else
		9157	plongarray(p2)[x] := 0;
		9158	if x > 0 then
		9159	if plongarray(p2)[x - 1] > 2 then
		9160	plongarray(p2)[x - 1] := plongarray(p2)[x - 1] - 2
		9161	else
		9162	plongarray(p2)[x - 1] := 0;
		9163	if x < (DIB.Width - 1) then
		9164	if plongarray(p2)[x + 1] > 2 then
		9165	plongarray(p2)[x + 1] := plongarray(p2)[x + 1] - 2
		9166	else
		9167	plongarray(p2)[x + 1] := 0;
		9168	end;
		9169	if plongarray(p)[x] > 8 then
		9170	plongarray(p)[x] := plongarray(p)[x] - 8
		9171	else
		9172	plongarray(p)[x] := 0;
		9173	if x > 0 then
		9174	if plongarray(p)[x - 1] > 4 then
		9175	plongarray(p)[x - 1] := plongarray(p)[x - 1] - 4
		9176	else
		9177	plongarray(p)[x - 1] := 0;
		9178	if x < (DIB.Width - 1) then
		9179	if plongarray(p)[x + 1] > 4 then
		9180	plongarray(p)[x + 1] := plongarray(p)[x + 1] - 4
		9181	else
		9182	plongarray(p)[x + 1] := 0;
		9183	end;
		9184	end;
		9185	end {case};
		9186	end;
		9187	end;
		9188	end;
		9189
		9190	procedure TDIB.Distort(DIB1: TDIB; dt: TDistortType; cX, cY, Angle: Integer; Factor: Real);
		9191	type
		9192	T3Byte = array[0..2] of Byte;
		9193	P3ByteArray = ^T3ByteArray;
		9194	T3ByteArray = array[0..32767] of T3Byte;
		9195	PLongArray = ^TLongArray;
		9196	TLongArray = array[0..32767] of LongInt;
		9197	var
		9198	p, p2: PByteArray;
		9199	x, y, x2, y2, angled, ysqr: Integer;
		9200	actdist, dist, cosy, siny: real;
		9201	begin
		9202	dist := Factor * sqrt(sqr(cX) + sqr(cY));
		9203	for y := 0 to DIB1.Height - 1 do
		9204	begin
		9205	p := DIB1.ScanLine[y];
		9206	ysqr := sqr(y - cY);
		9207	for x := 0 to (DIB1.Width) - 1 do
		9208	begin
		9209	actdist := (sqrt((sqr(x - cX) + ysqr)) / dist);
		9210	if dt = dtSlow then
		9211	actdist := dsin((Trunc(actdist * 1024)) and $1FF);
		9212	angled := 384 + Trunc((actdist) * Angle);
		9213
		9214	cosy := (y - cY) * dcos(angled and $1FF);
		9215	siny := (y - cY) * dsin(angled and $1FF);
		9216
		9217	x2 := Trunc((x - cX) * dsin(angled and $1FF) + cosy) + cX;
		9218	y2 := Trunc((x - cX) * dcos(angled and $1FF) - siny) + cY;
		9219	case bitcount of
		9220	8:
		9221	begin
		9222	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		9223	begin
		9224	p2 := ScanLine[y2];
		9225	p[x] := p2[Width - x2];
		9226	end
		9227	else
		9228	begin
		9229	if p[x] > 2 then
		9230	p[x] := p[x] - 2
		9231	else
		9232	p[x] := 0;
		9233	end;
		9234	end;
		9235	16:
		9236	begin
		9237	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		9238	begin
		9239	pwordarray(p2) := ScanLine[y2];
		9240	pwordarray(p)[x] := pwordarray(p2)[Width - x2];
		9241	end
		9242	else
		9243	begin
		9244	if pwordarray(p)[x] > 2 then
		9245	pwordarray(p)[x] := pwordarray(p)[x] - 2
		9246	else
		9247	pwordarray(p)[x] := 0;
		9248	end;
		9249	end;
		9250	24:
		9251	begin
		9252	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		9253	begin
		9254	P3ByteArray(p2) := ScanLine[y2];
		9255	P3ByteArray(p)[x] := P3ByteArray(p2)[Width - x2];
		9256	end
		9257	else
		9258	begin
		9259	if P3ByteArray(p)[x][0] > 2 then
		9260	P3ByteArray(p)[x][0] := P3ByteArray(p)[x][0] - 2
		9261	else if P3ByteArray(p)[x][1] > 2 then
		9262	P3ByteArray(p)[x][1] := P3ByteArray(p)[x][1] - 2
		9263	else if P3ByteArray(p)[x][2] > 2 then
		9264	P3ByteArray(p)[x][2] := P3ByteArray(p)[x][2] - 2
		9265	else
		9266	begin
		9267	P3ByteArray(p)[x][0] := 0;
		9268	P3ByteArray(p)[x][1] := 0;
		9269	P3ByteArray(p)[x][2] := 0;
		9270	end;
		9271	end;
		9272	end;
		9273	32:
		9274	begin
		9275	if (y2 >= 0) and (y2 < Height) and (x2 >= 0) and (x2 < Width) then
		9276	begin
		9277	plongarray(p2) := ScanLine[y2];
		9278	plongarray(p)[x] := plongarray(p2)[Width - x2];
		9279	end
		9280	else
		9281	begin
		9282	if p[x] > 2 then
		9283	plongarray(p)[x] := plongarray(p)[x] - 2
		9284	else
		9285	plongarray(p)[x] := 0;
		9286	end;
		9287	end;
		9288	end {case}
		9289	end;
		9290	end;
		9291	end;
		9292
		9293	procedure TDIB.AntialiasedLine(x1, y1, x2, y2: Integer; color: TColor);
		9294	//anti-aliased line using the Wu algorithm by Peter Bone
		9295	var
		9296	dX, dY, X, Y, start, finish: Integer;
		9297	LM, LR: Integer;
		9298	dxi, dyi, dydxi: Integer;
		9299	P: PLines;
		9300	R, G, B: byte;
		9301	begin
		9302	R := GetRValue(Color);
		9303	G := GetGValue(Color);
		9304	B := GetBValue(Color);
		9305	dX := abs(x2 - x1); // Calculate deltax and deltay for initialisation
		9306	dY := abs(y2 - y1);
		9307	if (dX = 0) or (dY = 0) then
		9308	begin
		9309	Canvas.Pen.Color := (B shl 16) + (G shl 8) + R;
		9310	Canvas.MoveTo(x1, y1);
		9311	Canvas.LineTo(x2, y2);
		9312	exit;
		9313	end;
		9314	if dX > dY then
		9315	begin // horizontal or vertical
		9316	if y2 > y1 then // determine rise and run
		9317	dydxi := -dY shl 16 div dX
		9318	else
		9319	dydxi := dY shl 16 div dX;
		9320	if x2 < x1 then
		9321	begin
		9322	start := x2; // right to left
		9323	finish := x1;
		9324	dyi := y2 shl 16;
		9325	end
		9326	else
		9327	begin
		9328	start := x1; // left to right
		9329	finish := x2;
		9330	dyi := y1 shl 16;
		9331	dydxi := -dydxi; // inverse slope
		9332	end;
		9333	if finish >= Width then finish := Width - 1;
		9334	for X := start to finish do
		9335	begin
		9336	Y := dyi shr 16;
		9337	if (X < 0) or (Y < 0) or (Y > Height - 2) then
		9338	begin
		9339	Inc(dyi, dydxi);
		9340	Continue;
		9341	end;
		9342	LM := dyi - Y shl 16; // fractional part of dyi - in fixed-point
		9343	LR := 65536 - LM;
		9344	P := Scanline[Y];
		9345	P^[X].B := (B * LR + P^[X].B * LM) shr 16;
		9346	P^[X].G := (G * LR + P^[X].G * LM) shr 16;
		9347	P^[X].R := (R * LR + P^[X].R * LM) shr 16;
		9348	//Inc(Y);
		9349	P^[X].B := (B * LM + P^[X].B * LR) shr 16;
		9350	P^[X].G := (G * LM + P^[X].G * LR) shr 16;
		9351	P^[X].R := (R * LM + P^[X].R * LR) shr 16;
		9352	Inc(dyi, dydxi); // next point
		9353	end;
		9354	end
		9355	else
		9356	begin
		9357	if x2 > x1 then // determine rise and run
		9358	dydxi := -dX shl 16 div dY
		9359	else
		9360	dydxi := dX shl 16 div dY;
		9361	if y2 < y1 then
		9362	begin
		9363	start := y2; // right to left
		9364	finish := y1;
		9365	dxi := x2 shl 16;
		9366	end
		9367	else
		9368	begin
		9369	start := y1; // left to right
		9370	finish := y2;
		9371	dxi := x1 shl 16;
		9372	dydxi := -dydxi; // inverse slope
		9373	end;
		9374	if finish >= Height then finish := Height - 1;
		9375	for Y := start to finish do
		9376	begin
		9377	X := dxi shr 16;
		9378	if (Y < 0) or (X < 0) or (X > Width - 2) then
		9379	begin
		9380	Inc(dxi, dydxi);
		9381	Continue;
		9382	end;
		9383	LM := dxi - X shl 16;
		9384	LR := 65536 - LM;
		9385	P := Scanline[Y];
		9386	P^[X].B := (B * LR + P^[X].B * LM) shr 16;
		9387	P^[X].G := (G * LR + P^[X].G * LM) shr 16;
		9388	P^[X].R := (R * LR + P^[X].R * LM) shr 16;
		9389	Inc(X);
		9390	P^[X].B := (B * LM + P^[X].B * LR) shr 16;
		9391	P^[X].G := (G * LM + P^[X].G * LR) shr 16;
		9392	P^[X].R := (R * LM + P^[X].R * LR) shr 16;
		9393	Inc(dxi, dydxi); // next point
		9394	end;
		9395	end;
		9396	end;
16	daniel-mar	9397	(*
4	daniel-mar	9398	function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue,
		9399	FromPoint, ToPoint: Extended): TColor;
		9400	var F: Extended; r1, r2, r3, g1, g2, g3, b1, b2, b3: Byte;
		9401	function CalcColorBytes(fb1, fb2: Byte): Byte;
		9402	begin
		9403	result := fb1;
		9404	if fb1 < fb2 then Result := FB1 + Trunc(F * (fb2 - fb1));
		9405	if fb1 > fb2 then Result := FB1 - Trunc(F * (fb1 - fb2));
		9406	end;
		9407	begin
		9408	if Pointvalue <= FromPoint then
		9409	begin
		9410	result := StartColor;
		9411	exit;
		9412	end;
		9413	if Pointvalue >= ToPoint then
		9414	begin
		9415	result := EndColor;
		9416	exit;
		9417	end;
		9418	F := (Pointvalue - FromPoint) / (ToPoint - FromPoint);
		9419	asm
		9420	mov EAX, Startcolor
		9421	cmp EAX, EndColor
		9422	je @@exit //when equal then exit
		9423	mov r1, AL
		9424	shr EAX,8
		9425	mov g1, AL
		9426	shr EAX,8
		9427	mov b1, AL
		9428	mov EAX, Endcolor
		9429	mov r2, AL
		9430	shr EAX,8
		9431	mov g2, AL
		9432	shr EAX,8
		9433	mov b2, AL
		9434	push ebp
		9435	mov AL, r1
		9436	mov DL, r2
		9437	call CalcColorBytes
		9438	pop ECX
		9439	push EBP
		9440	Mov r3, AL
		9441	mov DL, g2
		9442	mov AL, g1
		9443	call CalcColorBytes
		9444	pop ECX
		9445	push EBP
		9446	mov g3, Al
		9447	mov DL, B2
		9448	mov Al, B1
		9449	call CalcColorBytes
		9450	pop ECX
		9451	mov b3, AL
		9452	XOR EAX,EAX
		9453	mov AL, B3
		9454	shl EAX,8
		9455	mov AL, G3
		9456	shl EAX,8
		9457	mov AL, R3
		9458	@@Exit:
		9459	mov @result, EAX
		9460	end;
		9461	end;
16	daniel-mar	9462	*)
		9463	function TDIB.GetColorBetween(StartColor, EndColor: TColor; Pointvalue, FromPoint, ToPoint: Extended): TColor;
		9464	var
		9465	F: Extended;
		9466	r1, g1, b1, r2, g2, b2, r3, g3, b3: Byte;
4	daniel-mar	9467
16	daniel-mar	9468	function CalcColorBytes(const factor: Extended; const fb1, fb2: Byte): Byte; {$IFDEF VER9UP}inline;{$ENDIF}
		9469	begin
		9470	Result := fb1;
		9471	if fb1 < fb2 then Result := fb1 + Trunc(factor * (fb2 - fb1));
		9472	if fb1 > fb2 then Result := fb1 - Trunc(factor * (fb1 - fb2));
		9473	end;
		9474
		9475	procedure GetRGB(const AColor: TColor; var R, G, B: Byte); {$IFDEF VER9UP}inline;{$ENDIF}
		9476	begin
		9477	R := AColor and $FF;
		9478	G := (AColor shr 8) and $FF;
		9479	B := (AColor shr 16) and $FF;
		9480	end;
		9481
		9482	begin
		9483	if Pointvalue <= FromPoint then
		9484	begin
		9485	Result := StartColor;
		9486	Exit;
		9487	end;
		9488	if Pointvalue >= ToPoint then
		9489	begin
		9490	Result := EndColor;
		9491	Exit;
		9492	end;
		9493
		9494	F := (Pointvalue - FromPoint) / (ToPoint - FromPoint);
		9495
		9496	GetRGB(StartColor, r1, g1, b1);
		9497	// r1 := StartColor and $FF;
		9498	// g1 := (StartColor shr 8) and $FF;
		9499	// b1 := (StartColor shr 16) and $FF;
		9500	GetRGB(StartColor, r2, g2, b2);
		9501	// r2 := EndColor and $FF;
		9502	// g2 := (EndColor shr 8) and $FF;
		9503	// b2 := (EndColor shr 16) and $FF;
		9504
		9505	r3 := CalcColorBytes(F, r1, r2);
		9506	g3 := CalcColorBytes(F, g1, g2);
		9507	b3 := CalcColorBytes(F, b1, b2);
		9508
		9509	Result := (b3 shl 16) or (g3 shl 8) or r3;
		9510	end;
		9511
4	daniel-mar	9512	procedure TDIB.ColoredLine(const iStart, iEnd: TPoint; iColorStyle: TColorLineStyle;
		9513	iGradientFrom, iGradientTo: TColor; iPixelGeometry: TColorLinePixelGeometry; iRadius: Word);
		9514	var
		9515	tempColor: TColor;
		9516	const
		9517	WavelengthMinimum = 380;
		9518	WavelengthMaximum = 780;
		9519
		9520	procedure SetColor(Color: TColor);
		9521	begin
		9522	Canvas.Pen.Color := Color;
		9523	Canvas.Brush.Color := Color;
		9524	tempColor := Color
		9525	end {SetColor};
		9526
		9527	function WL2RGB(const Wavelength: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
		9528	const
		9529	Gamma = 0.80;
		9530	IntensityMax = 255;
		9531	var
		9532	Red, Blue, Green, Factor: Double;
		9533
		9534	function Adjust(const Color, Factor: Double): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
		9535	begin
		9536	if Color = 0.0 then Result := 0
		9537	else Result := Round(IntensityMax * Power(Color * Factor, Gamma))
		9538	end {Adjust};
		9539	begin
		9540	case Trunc(Wavelength) of
		9541	380..439:
		9542	begin
		9543	Red := -(Wavelength - 440) / (440 - 380);
		9544	Green := 0.0;
		9545	Blue := 1.0
		9546	end;
		9547	440..489:
		9548	begin
		9549	Red := 0.0;
		9550	Green := (Wavelength - 440) / (490 - 440);
		9551	Blue := 1.0
		9552	end;
		9553	490..509:
		9554	begin
		9555	Red := 0.0;
		9556	Green := 1.0;
		9557	Blue := -(Wavelength - 510) / (510 - 490)
		9558	end;
		9559	510..579:
		9560	begin
		9561	Red := (Wavelength - 510) / (580 - 510);
		9562	Green := 1.0;
		9563	Blue := 0.0
		9564	end;
		9565	580..644:
		9566	begin
		9567	Red := 1.0;
		9568	Green := -(Wavelength - 645) / (645 - 580);
		9569	Blue := 0.0
		9570	end;
		9571	645..780:
		9572	begin
		9573	Red := 1.0;
		9574	Green := 0.0;
		9575	Blue := 0.0
		9576	end;
		9577	else
		9578	Red := 0.0;
		9579	Green := 0.0;
		9580	Blue := 0.0
		9581	end;
		9582	case Trunc(Wavelength) of
		9583	380..419: factor := 0.3 + 0.7 * (Wavelength - 380) / (420 - 380);
		9584	420..700: factor := 1.0;
		9585	701..780: factor := 0.3 + 0.7 * (780 - Wavelength) / (780 - 700)
		9586	else
		9587	factor := 0.0
		9588	end;
		9589	Result := RGB(Adjust(Red, Factor), Adjust(Green, Factor), Adjust(Blue, Factor));
		9590	end;
		9591
		9592	function Rainbow(const fraction: Double): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
		9593	begin
		9594	if (fraction < 0.0) or (fraction > 1.0) then Result := clBlack
		9595	else
		9596	Result := WL2RGB(WavelengthMinimum + Fraction * (WavelengthMaximum - WavelengthMinimum))
		9597	end {Raindbow};
		9598
		9599	function ColorInterpolate(const fraction: Double; const Color1, Color2: TColor): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
		9600	var
		9601	complement: Double;
		9602	R1, R2, G1, G2, B1, B2: BYTE;
		9603	begin
		9604	if fraction <= 0 then Result := Color1
		9605	else
		9606	if fraction >= 1.0 then Result := Color2
		9607	else
		9608	begin
		9609	R1 := GetRValue(Color1);
		9610	G1 := GetGValue(Color1);
		9611	B1 := GetBValue(Color1);
		9612	R2 := GetRValue(Color2);
		9613	G2 := GetGValue(Color2);
		9614	B2 := GetBValue(Color2);
		9615	complement := 1.0 - fraction;
		9616	Result := RGB(Round(complement * R1 + fraction * R2),
		9617	Round(complement * G1 + fraction * G2),
		9618	Round(complement * B1 + fraction * B2))
		9619	end
		9620	end {ColorInterpolate};
		9621
		9622	// Conversion utility routines
		9623	function ColorToRGBTriple(const Color: TColor): TRGBTriple; {$IFDEF VER9UP}inline;{$ENDIF}
		9624	begin
		9625	with Result do
		9626	begin
		9627	rgbtRed := GetRValue(Color);
		9628	rgbtGreen := GetGValue(Color);
		9629	rgbtBlue := GetBValue(Color)
		9630	end
		9631	end {ColorToRGBTriple};
		9632
		9633	function RGBTripleToColor(const Triple: TRGBTriple): TColor; {$IFDEF VER9UP}inline;{$ENDIF}
		9634	begin
		9635	Result := RGB(Triple.rgbtRed, Triple.rgbtGreen, Triple.rgbtBlue)
		9636	end {RGBTripleToColor};
		9637	// Bresenham's Line Algorithm. Byte, March 1988, pp. 249-253.
		9638	var
		9639	a, b, d, diag_inc, dXdg, dXndg, dYdg, dYndg, i, nDginc, nDswap, x, y: Integer;
		9640	begin {DrawLine}
		9641	x := iStart.X;
		9642	y := iStart.Y;
		9643	a := iEnd.X - iStart.X;
		9644	b := iEnd.Y - iStart.Y;
		9645	if a < 0 then
		9646	begin
		9647	a := -a;
		9648	dXdg := -1
		9649	end
		9650	else dXdg := 1;
		9651	if b < 0 then
		9652	begin
		9653	b := -b;
		9654	dYdg := -1
		9655	end
		9656	else dYdg := 1;
		9657	if a < b then
		9658	begin
		9659	nDswap := a;
		9660	a := b;
		9661	b := nDswap;
		9662	dXndg := 0;
		9663	dYndg := dYdg
		9664	end
		9665	else
		9666	begin
		9667	dXndg := dXdg;
		9668	dYndg := 0
		9669	end;
		9670	d := b + b - a;
		9671	nDginc := b + b;
		9672	diag_inc := b + b - a - a;
		9673	for i := 0 to a do
		9674	begin
		9675	case iPixelGeometry of
		9676	pgPoint:
		9677	case iColorStyle of
		9678	csSolid:
		9679	Canvas.Pixels[x, y] := tempColor;
		9680	csGradient:
		9681	Canvas.Pixels[x, y] := ColorInterpolate(i / a, iGradientFrom, iGradientTo);
		9682	csRainbow:
		9683	Canvas.Pixels[x, y] := Rainbow(i / a)
		9684	end;
		9685	pgCircular:
		9686	begin
		9687	case iColorStyle of
		9688	csSolid: ;
		9689	csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
		9690	csRainbow: SetColor(Rainbow(i / a))
		9691	end;
		9692	Canvas.Ellipse(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
		9693	end;
		9694	pgRectangular:
		9695	begin
		9696	case iColorStyle of
		9697	csSolid: ;
		9698	csGradient: SetColor(ColorInterpolate(i / a, iGradientFrom, iGradientTo));
		9699	csRainbow: SetColor(Rainbow(i / a))
		9700	end;
		9701	Canvas.Rectangle(x - iRadius, y - iRadius, x + iRadius, y + iRadius)
		9702	end
		9703	end;
		9704	if d < 0 then
		9705	begin
		9706	Inc(x, dXndg);
		9707	Inc(y, dYndg);
		9708	Inc(d, nDginc);
		9709	end
		9710	else
		9711	begin
		9712	Inc(x, dXdg);
		9713	Inc(y, dYdg);
		9714	Inc(d, diag_inc);
		9715	end
		9716	end
		9717	end {Line};
		9718
16	daniel-mar	9719	procedure TDIB.DoNovaEffect(const sr, sg, sb, cx, cy, radius,
4	daniel-mar	9720	nspokes, randomhue, randomspok, randgauss: Integer; onProgress: TProgressEvent);
		9721	// Copyright (c) 2000 by Keith Murray (kmurray@hotfreeware.com)
		9722	// All rights reserved.
		9723	// Adapted for DIB by JB.
		9724	type
		9725	PByteArray = ^TByteArray;
		9726	TByteArray = array[0..32767] of Byte;
		9727	PDoubleArray = ^TDoubleArray;
16	daniel-mar	9728	TDoubleArray = array[0..0] of Double;
4	daniel-mar	9729	PIntegerArray = ^TIntegerArray;
16	daniel-mar	9730	TIntegerArray = array[0..0] of Integer;
4	daniel-mar	9731	type
		9732	TProgressEvent = procedure(progress: Integer; message: string;
		9733	var cancel: Boolean) of object;
		9734	const
		9735	M_PI = 3.14159265358979323846;
		9736	RAND_MAX = 2147483647;
		9737
16	daniel-mar	9738	function Gauss(const randgauss: Integer): double; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	9739	const magnitude = 6;
		9740	var
		9741	sum: double;
		9742	i: Integer;
		9743	begin
		9744	sum := 0;
		9745	for i := 1 to magnitude do
		9746	sum := sum + (randgauss / 2147483647);
		9747	result := sum / magnitude;
		9748	end;
		9749
16	daniel-mar	9750	function Clamp(const i, l, h: double): double; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	9751	begin
		9752	if i < l then
		9753	result := l
		9754	else
		9755	if i > h then
		9756	result := h
		9757	else
		9758	result := i;
		9759	end;
		9760
16	daniel-mar	9761	function IClamp(const i, l, h: Integer): Integer; {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	9762	begin
		9763	if i < l then
		9764	result := l
		9765	else if i > h then
		9766	result := h
		9767	else result := i;
		9768	end;
16	daniel-mar	9769	{$IFNDEF VER9UP}
		9770	procedure rgb_to_hsl(const r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF}
4	daniel-mar	9771	{$IFNDEF VER4UP}
		9772	function Max(a, b: Double): Double;
		9773	begin
		9774	Result := a; if b > a then Result := b;
		9775	end;
		9776	function Min(a, b: Double): Double;
		9777	begin
		9778	Result := a; if b < a then Result := b;
		9779	end;
		9780	{$ENDIF}
		9781	var
		9782	v, m, vm: Double;
		9783	r2, g2, b2: Double;
		9784	begin
		9785	h := 0;
		9786	s := 0;
		9787	l := 0;
		9788	v := Max(r, g);
		9789	v := Max(v, b);
		9790	m := Min(r, g);
		9791	m := Min(m, b);
		9792	l := (m + v) / 2.0;
		9793	if l <= 0.0 then
		9794	exit;
		9795	vm := v - m;
		9796	s := vm;
		9797	if s > 0.0 then
		9798	begin
		9799	if l <= 0.5 then
		9800	s := s / (v + m)
		9801	else s := s / (2.0 - v - m);
		9802	end
		9803	else exit;
		9804	r2 := (v - 4) / vm;
		9805	g2 := (v - g) / vm;
		9806	b2 := (v - b) / vm;
		9807	if r = v then
		9808	begin
		9809	if g = m then
		9810	h := b2 + 5.0
		9811	else h := 1.0 - g2;
		9812	end
		9813	else if g = v then
		9814	begin
		9815	if b = m then
		9816	h := 1.0 + r2
		9817	else h := 3.0 - b2;
		9818	end
		9819	else
		9820	begin
		9821	if r = m then
		9822	h := 3.0 + g2
		9823	else h := 5.0 - r2;
		9824	end;
		9825	h := h / 6;
		9826	end;
		9827
		9828	procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF}
		9829	var
		9830	v: Double;
		9831	m, sv: Double;
		9832	sextant: Integer;
		9833	fract, vsf, mid1, mid2: Double;
		9834	begin
		9835	if l <= 0.5 then
		9836	v := l * (1.0 + sl)
		9837	else v := l + sl - l * sl;
		9838	if v <= 0 then
		9839	begin
		9840	r := 0.0;
		9841	g := 0.0;
		9842	b := 0.0;
		9843	end
		9844	else
		9845	begin
		9846	m := l + l - v;
		9847	sv := (v - m) / v;
		9848	h := h * 6.0;
		9849	sextant := Trunc(h);
		9850	fract := h - sextant;
		9851	vsf := v * sv * fract;
		9852	mid1 := m + vsf;
		9853	mid2 := v - vsf;
		9854	case sextant of
		9855	0:
		9856	begin
		9857	r := v; g := mid1; b := m;
		9858	end;
		9859	1:
		9860	begin
		9861	r := mid2; g := v; b := m;
		9862	end;
		9863	2:
		9864	begin
		9865	r := m; g := v; b := mid1;
		9866	end;
		9867	3:
		9868	begin
		9869	r := m; g := mid2; b := v;
		9870	end;
		9871	4:
		9872	begin
		9873	r := mid1; g := m; b := v;
		9874	end;
		9875	5:
		9876	begin
		9877	r := v; g := m; b := mid2;
		9878	end;
		9879	end;
		9880	end;
		9881	end;
16	daniel-mar	9882	{$ELSE}
		9883	procedure rgb_to_hsl(const r, g, b: Double; var h, s, l: Double); {$IFDEF VER9UP}inline;{$ENDIF}
		9884	var
		9885	h0, s0, l0: Word;
		9886	begin //procedure ColorRGBToHLS(clrRGB: TColorRef; var Hue, Luminance, Saturation: Word);
		9887	GraphUtil.ColorRGBToHLS(RGB(Trunc(r),Trunc(g),Trunc(b)), h0, s0, l0);
		9888	h := h0;
		9889	s := s0;
		9890	l := l0;
		9891	end;
4	daniel-mar	9892
16	daniel-mar	9893	procedure hsl_to_rgb(h, sl, l: Double; var r, g, b: Double); {$IFDEF VER9UP}inline;{$ENDIF}
		9894	var X: TColorRef;
		9895	begin //function ColorHLSToRGB(Hue, Luminance, Saturation: Word): TColorRef;
		9896	X := GraphUtil.ColorHLSToRGB(Trunc(h), Trunc(l), Trunc(sl));
		9897	r := GetRValue(X);
		9898	g := GetGValue(X);
		9899	b := GetBValue(X);
		9900	end;
		9901	{$ENDIF}
		9902
4	daniel-mar	9903	var
		9904	src_row, dest_row: PByte;
		9905	src, dest: PByteArray;
		9906	color, colors: array[0..3] of Integer;
		9907	SpokeColor: PIntegerArray;
		9908	spoke: PDoubleArray;
16	daniel-mar	9909	x2, row, col, x, y, alpha, has_alpha, bpp, xc, yc, i, j: Integer;
		9910	u, v, l, l0, w, w1, c, nova_alpha, new_alpha, compl_ratio, ratio, r, g, b, h, s, lu, SpokeCol: Double;
4	daniel-mar	9911	dstDIB: TDIB;
		9912	begin
		9913	colors[0] := sr;
		9914	colors[1] := sg;
		9915	colors[2] := sb;
		9916	new_alpha := 0;
		9917
		9918	GetMem(spoke, NSpokes * sizeof(Double));
		9919	GetMem(spokecolor, NSpokes * sizeof(Integer) * 3);
		9920	dstDIB := TDIB.Create;
		9921	try
16	daniel-mar	9922	dstDIB.Assign(Self);
		9923	dstDIB.Canvas.Brush.Color := clBlack;
		9924	dstDIB.Canvas.FillRect(dstDIB.Canvas.ClipRect);
		9925	// R G B
4	daniel-mar	9926	rgb_to_hsl(colors[0] / 255.0, colors[1] / 255.0, colors[2] / 255.0, h, s, lu);
		9927
		9928	for i := 0 to NSpokes - 1 do
		9929	begin
16	daniel-mar	9930	spoke[i] := gauss(randgauss);
4	daniel-mar	9931	h := h + randomhue / 360.0 * ({Random(RAND_MAX)}RandomSpok / RAND_MAX - 0.5);
		9932	if h < 0 then
		9933	h := h + 1.0
		9934	else if h > 1.0 then
		9935	h := h - 1.0;
		9936	hsl_to_rgb(h, s, lu, r, g, b);
		9937	spokecolor[3 * i + 0] := Trunc(255 * r);
		9938	spokecolor[3 * i + 1] := Trunc(255 * g);
		9939	spokecolor[3 * i + 2] := Trunc(255 * b);
		9940	end;
		9941
		9942	xc := cx;
		9943	yc := cy;
		9944	l0 := (x2 - xc) / 4 + 1;
		9945	bpp := Self.BitCount div 8;
		9946	has_alpha := 0;
		9947	alpha := bpp;
		9948	y := 0;
16	daniel-mar	9949	for row := 0 to Self.Height - 1 do
		9950	begin
4	daniel-mar	9951	src_row := Self.ScanLine[row];
		9952	dest_row := dstDIB.ScanLine[row];
		9953	src := Pointer(src_row);
		9954	dest := Pointer(dest_row);
		9955	x := 0;
16	daniel-mar	9956	for col := 0 to Self.Width - 1 do
		9957	begin
4	daniel-mar	9958	u := (x - xc) / radius;
		9959	v := (y - yc) / radius;
16	daniel-mar	9960	l := sqrt(sqr(u) + sqr(v));
4	daniel-mar	9961	c := (arctan2(u, v) / (2 * M_PI) + 0.51) * NSpokes;
		9962	i := floor(c);
		9963	c := c - i;
		9964	i := i mod NSpokes;
		9965	w1 := spoke[i] * (1 - c) + spoke[(i + 1) mod NSpokes] * c;
		9966	w1 := w1 * w1;
		9967	w := 1 / (l + 0.001) * 0.9;
		9968	nova_alpha := Clamp(w, 0.0, 1.0);
		9969	ratio := nova_alpha;
		9970	compl_ratio := 1.0 - ratio;
		9971	for j := 0 to alpha - 1 do
		9972	begin
		9973	spokecol := spokecolor[3 * i + j] * (1.0 - c) + spokecolor[3 * ((i + 1) mod nspokes) + j] * c;
		9974	if w > 1.0 then
		9975	color[j] := IClamp(Trunc(spokecol * w), 0, 255)
		9976	else
		9977	color[j] := Trunc(src[j] * compl_ratio + spokecol * ratio);
		9978	color[j] := Trunc(color[j] + 255 * Clamp(w1 * w, 0.0, 1.0));
		9979	dest[j] := IClamp(color[j], 0, 255);
		9980	end;
16	daniel-mar	9981	{$IFDEF WIN64}
		9982	Inc(PByte(src), bpp);
		9983	Inc(PBYTE(dest), bpp);
		9984	{$ELSE}
		9985	Inc(Integer(src), bpp);
		9986	Inc(Integer(dest), bpp);
		9987	{$ENDIF}
		9988	Inc(x);
4	daniel-mar	9989	end;
16	daniel-mar	9990	Inc(y);
4	daniel-mar	9991	end;
16	daniel-mar	9992	Self.Assign(dstDIB);
4	daniel-mar	9993	finally
		9994	dstDIB.Free;
		9995	FreeMem(Spoke);
		9996	FreeMem(SpokeColor);
		9997	end;
		9998	end;
		9999
		10000	procedure TDIB.DrawMandelbrot(ao, au: Integer; bo, bu: Double);
		10001	var
		10002	c1, c2, z1, z2, tmp: Double;
		10003	i, j, Count: Integer;
		10004	dstDIB: TDIB;
		10005	X, Y: Double;
		10006	X2, Y2: Integer;
		10007	begin
		10008	dstDIB := TDIB.Create;
		10009	dstDIB.Assign(Self);
		10010	X2 := dstDIB.FWidth;
		10011	Y2 := dstDIB.FHeight;
		10012	{as Example
		10013	ao := 1;
		10014	au := -2;
		10015	bo := 1.5;
		10016	bu := -1.5;
		10017	}
		10018	X := (ao - au) / dstDIB.FWidth;
		10019	Y := (bo - bu) / dstDIB.FHeight;
		10020	try
		10021	c2 := bu;
		10022	for i := 10 to X2 do
		10023	begin
		10024	c1 := au;
		10025	for j := 0 to Y2 do
		10026	begin
		10027	z1 := 0;
		10028	z2 := 0;
		10029	Count := 0;
		10030	{count is deep of iteration of the mandelbrot set
		10031	if \|z\| >=2 then z is not a member of a mandelset}
		10032	while (((z1 * z1 + z2 * z2 < 4) and (Count <= 90))) do
		10033	begin
		10034	tmp := z1;
		10035	z1 := z1 * z1 - z2 * z2 + c1;
		10036	z2 := 2 * tmp * z2 + c2;
		10037	Inc(Count);
		10038	end;
		10039	//the color-palette depends on TColor(n*count mod t)
		10040	dstDIB.Canvas.Pixels[j, i] := (16 * Count mod 255);
		10041	c1 := c1 + X;
		10042	end;
		10043	c2 := c2 + Y;
		10044	end;
		10045	finally
		10046	Self.Assign(dstDIB);
		10047	dstDIB.Free;
		10048	end;
		10049	end;
		10050
		10051	procedure TDIB.SephiaEffect(Depth: Integer{$IFDEF VER4UP} = 20{$ENDIF});
		10052	{Note: when depth parameter set to 0 will produce black and white picture only}
		10053	var
16	daniel-mar	10054	color, color2: LongInt;
4	daniel-mar	10055	r, g, b, rr, gg: byte;
		10056	h, w: Integer;
16	daniel-mar	10057	p0: PByteArray;
4	daniel-mar	10058	x, y: Integer;
		10059	begin
		10060	if Self.BitCount = 24 then
		10061	begin
		10062	Self.DoGrayScale;
		10063	for y := 0 to Self.Height - 1 do
		10064	begin
		10065	p0 := Self.ScanLine[y];
		10066	for x := 0 to Self.Width - 1 do
		10067	begin
		10068	r := p0[x * 3];
		10069	g := p0[x * 3 + 1];
		10070	b := p0[x * 3 + 2];
		10071	rr := r + (depth * 2);
		10072	gg := g + depth;
		10073	if rr <= ((depth * 2) - 1) then
		10074	rr := 255;
		10075	if gg <= (depth - 1) then
		10076	gg := 255;
		10077	p0[x * 3] := rr;
		10078	p0[x * 3 + 1] := gg;
		10079	p0[x * 3 + 2] := b;
		10080	end;
		10081	end;
		10082	Exit
		10083	end;
		10084	{this alogorithm is slower because does not use scanline property}
		10085	for h := 0 to Self.Height-1 do
		10086	begin
		10087	for w := 0 to Self.Width-1 do
		10088	begin
		10089	//first convert the bitmap to greyscale
		10090	color := ColorToRGB(Self.Canvas.Pixels[w, h]);
		10091	r := GetRValue(color);
		10092	g := GetGValue(color);
		10093	b := GetBValue(color);
		10094	color2 := (r + g + b) div 3;
		10095	Self.Canvas.Pixels[w, h] := RGB(color2, color2, color2);
		10096	//then convert it to sepia
		10097	color := ColorToRGB(Self.Canvas.Pixels[w, h]);
		10098	r := GetRValue(color);
		10099	g := GetGValue(color);
		10100	b := GetBValue(color);
		10101	rr := r + (depth * 2);
		10102	gg := g + depth;
		10103	if rr <= ((depth * 2) - 1) then
		10104	rr := 255;
		10105	if gg <= (depth - 1) then
		10106	gg := 255;
		10107	Self.Canvas.Pixels[w, h] := RGB(rr, gg, b);
		10108	end;
		10109	end;
		10110
		10111	end;
		10112
		10113	procedure TDIB.EncryptDecrypt(const Key: Integer);
		10114	{for decript call it again}
		10115	var
		10116	BytesPorScan: Integer;
		10117	w, h: Integer;
		10118	p: pByteArray;
		10119	begin
		10120	try
		10121	BytesPorScan := Abs(Integer(Self.ScanLine[1]) -
		10122	Integer(Self.ScanLine[0]));
		10123	except
		10124	raise Exception.Create('Error ');
		10125	end;
		10126	RandSeed := Key;
		10127	for h := 0 to Self.Height - 1 do
		10128	begin
		10129	P := Self.ScanLine[h];
		10130	for w := 0 to BytesPorScan - 1 do
		10131	P^[w] := P^[w] xor Random(256);
		10132	end;
		10133	end;
		10134
		10135	procedure TDIB.LinePolar(x, y: Integer; AngleInDegree, Length: extended; Color: cardinal);
		10136	var
		10137	xp, yp: Integer;
		10138	begin
		10139	xp := Round(Sin(AngleInDegree * Pi / 180) * Length) + x;
		10140	yp := Round(Cos(AngleInDegree * Pi / 180) * Length) + y;
		10141	AntialiasedLine(x, y, xp, yp, Color);
		10142	end;
		10143
		10144	//y = 0.299g + 0.587b + 0.114*r;
		10145
		10146	procedure TDIB.BlendPixel(const X, Y: Integer; aColor: Cardinal; Alpha: byte);
		10147	var
		10148	cR, cG, cB: byte;
		10149	aR, aG, aB: byte;
		10150	dColor: Cardinal;
		10151	begin
		10152	aR := GetRValue(aColor);
		10153	aG := GetGValue(aColor);
		10154	aB := GetBValue(aColor);
		10155	dColor := Self.Canvas.Pixels[x, y];
		10156	cR := GetRValue(dColor);
		10157	cG := GetGValue(dColor);
		10158	cB := GetBValue(dColor);
		10159	Canvas.Pixels[x, y] := RGB((Alpha * (aR - cR) shr 8) + cR, // R alpha
		10160	(Alpha * (aG - cG) shr 8) + cG, // G alpha
		10161	(Alpha * (aB - cB) shr 8) + cB); // B alpha
		10162	end;
		10163
		10164
		10165	procedure MakeDib(out DIB: TDIB; const iWidth, iHeight, iBitCount: Integer; iFillColor: TColor{$IFDEF VER4UP} = clBlack{$ENDIF}); {$IFDEF VER4UP} overload; {$ENDIF}
		10166	begin
		10167	DIB := TDIB.Create;
		10168	DIB.SetSize(iWidth, iHeight, iBitCount);
		10169	DIB.Fill(iFillColor);
		10170	end;
		10171
		10172	procedure{$IFDEF VER4UP}MakeDib{$ELSE}MakeDib2{$ENDIF}(out DIB: TDIB; iBitmap: TBitmap); {$IFDEF VER4UP} overload; {$ENDIF}
		10173	begin
		10174	DIB := TDIB.Create;
		10175	if Assigned(iBitmap) then
		10176	DIB.CreateDIBFromBitmap(iBitmap)
		10177	else
		10178	DIB.Fill(clBlack);
		10179	end;
		10180
1	daniel-mar	10181	initialization
		10182	TPicture.RegisterClipBoardFormat(CF_DIB, TDIB);
		10183	TPicture.RegisterFileFormat('dib', 'Device Independent Bitmap', TDIB);
		10184	finalization
		10185	TPicture.UnRegisterGraphicClass(TDIB);
		10186
		10187	FEmptyDIBImage.Free;
		10188	FPaletteManager.Free;
4	daniel-mar	10189	end.

Subversion Repositories spacemission

spacemission/VCL_DELPHIX_D6/DIB.pas @ 4 – Rev 16