diff --git a/Packages/D6/X2CLGL.cfg b/Packages/D6/X2CLGL.cfg new file mode 100644 index 0000000..fcec3dd --- /dev/null +++ b/Packages/D6/X2CLGL.cfg @@ -0,0 +1,35 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R+ +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"c:\delphi6\Projects\Bpl" +-LN"c:\delphi6\Projects\Bpl" diff --git a/Packages/D6/X2CLGL.dof b/Packages/D6/X2CLGL.dof new file mode 100644 index 0000000..f44610d --- /dev/null +++ b/Packages/D6/X2CLGL.dof @@ -0,0 +1,112 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=1 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=X²CL GraphicList +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams=ip-to-country.csv countries.csv geo.db +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +c:\delphi6\Projects\Bpl\DIPasDocD6.bpl=DiPasDoc - Designtime +c:\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors +c:\delphi6\Bin\dclsmp60.bpl=Borland Sample Components +c:\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components +c:\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component +C:\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components +c:\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components +c:\delphi6\Bin\dclib60.bpl=InterBase Data Access Components +c:\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package +c:\delphi6\Bin\dcloffice2k60.bpl=Microsoft Office 2000 Sample Automation Server Wrapper Components +c:\delphi6\Bin\dcltee60.bpl=TeeChart Components +c:\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components +c:\delphi6\Bin\dclnet60.bpl=Borland Internet Components +c:\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment +c:\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components +c:\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components +c:\delphi6\Bin\dclocx60.bpl=Borland Sample Imported ActiveX Controls +c:\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components +C:\Program Files\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1b · www.madshi.net +C:\Program Files\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.3 · www.madshi.net +C:\Program Files\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.1b · www.madshi.net +C:\Program Files\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net +C:\Program Files\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3k · www.madshi.net +C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component +c:\delphi6\Projects\Bpl\PsychoTidyD6.bpl=PsychoTidy IDE Expert +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; diff --git a/Packages/D6/X2CLGL.dpk b/Packages/D6/X2CLGL.dpk new file mode 100644 index 0000000..fc53f79 --- /dev/null +++ b/Packages/D6/X2CLGL.dpk @@ -0,0 +1,36 @@ +package X2CLGL; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'X²CL GraphicList'} +{$RUNONLY} +{$IMPLICITBUILD ON} + +requires + rtl, + vcl; + +contains + X2CLGraphicList in '..\..\Source\X2CLGraphicList.pas'; + +end. diff --git a/Packages/D6/X2CLGL.res b/Packages/D6/X2CLGL.res new file mode 100644 index 0000000..a9c565b Binary files /dev/null and b/Packages/D6/X2CLGL.res differ diff --git a/Packages/D6/X2CLGLD.cfg b/Packages/D6/X2CLGLD.cfg new file mode 100644 index 0000000..fcec3dd --- /dev/null +++ b/Packages/D6/X2CLGLD.cfg @@ -0,0 +1,35 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R+ +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"c:\delphi6\Projects\Bpl" +-LN"c:\delphi6\Projects\Bpl" diff --git a/Packages/D6/X2CLGLD.dof b/Packages/D6/X2CLGLD.dof new file mode 100644 index 0000000..52d91cd --- /dev/null +++ b/Packages/D6/X2CLGLD.dof @@ -0,0 +1,112 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=1 +D=1 +E=0 +F=0 +G=1 +H=1 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=1 +P=1 +Q=0 +R=1 +S=0 +T=0 +U=0 +V=1 +W=0 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=1 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription=X²CL GraphicList (Designtime) +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath= +Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter +Conditionals= +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams=ip-to-country.csv countries.csv geo.db +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=1 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[Excluded Packages] +c:\delphi6\Projects\Bpl\DIPasDocD6.bpl=DiPasDoc - Designtime +c:\delphi6\Bin\dclshlctrls60.bpl=Shell Control Property and Component Editors +c:\delphi6\Bin\dclsmp60.bpl=Borland Sample Components +c:\delphi6\Bin\dclbde60.bpl=Borland BDE DB Components +c:\delphi6\Bin\dclcds60.bpl=Borland Base Cached ClientDataset Component +C:\Delphi6\Bin\dclmid60.bpl=Borland MyBase DataAccess Components +c:\delphi6\Bin\dclbdecds60.bpl=Borland Local BDE ClientDataset Components +c:\delphi6\Bin\dclib60.bpl=InterBase Data Access Components +c:\delphi6\Bin\DBWEBXPRT.BPL=Borland Web Wizard Package +c:\delphi6\Bin\dcloffice2k60.bpl=Microsoft Office 2000 Sample Automation Server Wrapper Components +c:\delphi6\Bin\dcltee60.bpl=TeeChart Components +c:\delphi6\Bin\dcltqr60.bpl=TeeChart for QuickReport Components +c:\delphi6\Bin\dclnet60.bpl=Borland Internet Components +c:\delphi6\Bin\dclite60.bpl=Borland Integrated Translation Environment +c:\delphi6\Bin\dcldbx60.bpl=Borland dbExpress Components +c:\delphi6\Bin\dclsoap60.bpl=Borland SOAP Components +c:\delphi6\Bin\dclocx60.bpl=Borland Sample Imported ActiveX Controls +c:\delphi6\Bin\dcldbxcds60.bpl=Borland Local DBX ClientDataset Components +C:\Program Files\madCollection\madRemote\Delphi 6\madRemote_.bpl=madRemote 1.1b · www.madshi.net +C:\Program Files\madCollection\madKernel\Delphi 6\madKernel_.bpl=madKernel 1.3 · www.madshi.net +C:\Program Files\madCollection\madCodeHook\Delphi 6\madCodeHook_.bpl=madCodeHook 2.1b · www.madshi.net +C:\Program Files\madCollection\madSecurity\Delphi 6\madSecurity_.bpl=madSecurity 1.1n · www.madshi.net +C:\Program Files\madCollection\madShell\Delphi 6\madShell_.bpl=madShell 1.3k · www.madshi.net +C:\WINDOWS\System32\ibevnt60.bpl=Borland Interbase Event Alerter Component +c:\delphi6\Projects\Bpl\PsychoTidyD6.bpl=PsychoTidy IDE Expert +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; diff --git a/Packages/D6/X2CLGLD.dpk b/Packages/D6/X2CLGLD.dpk new file mode 100644 index 0000000..a64800e --- /dev/null +++ b/Packages/D6/X2CLGLD.dpk @@ -0,0 +1,36 @@ +package X2CLGLD; + +{$R *.res} +{$ALIGN 8} +{$ASSERTIONS ON} +{$BOOLEVAL OFF} +{$DEBUGINFO ON} +{$EXTENDEDSYNTAX ON} +{$IMPORTEDDATA ON} +{$IOCHECKS ON} +{$LOCALSYMBOLS ON} +{$LONGSTRINGS ON} +{$OPENSTRINGS ON} +{$OPTIMIZATION ON} +{$OVERFLOWCHECKS OFF} +{$RANGECHECKS ON} +{$REFERENCEINFO ON} +{$SAFEDIVIDE OFF} +{$STACKFRAMES OFF} +{$TYPEDADDRESS OFF} +{$VARSTRINGCHECKS ON} +{$WRITEABLECONST ON} +{$MINENUMSIZE 1} +{$IMAGEBASE $400000} +{$DESCRIPTION 'X²CL GraphicList (Designtime)'} +{$DESIGNONLY} +{$IMPLICITBUILD ON} + +requires + rtl, + X2CLGL; + +contains + X2CLGLReg in '..\X2CLGLReg.pas'; + +end. diff --git a/Packages/D6/X2CLGLD.res b/Packages/D6/X2CLGLD.res new file mode 100644 index 0000000..a9c565b Binary files /dev/null and b/Packages/D6/X2CLGLD.res differ diff --git a/Packages/X2CLGLReg.pas b/Packages/X2CLGLReg.pas new file mode 100644 index 0000000..c23a885 --- /dev/null +++ b/Packages/X2CLGLReg.pas @@ -0,0 +1,24 @@ +{ + :: Registers the GraphicList components + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ +} +unit X2CLGLReg; + +interface + procedure Register; + +implementation +uses + Classes, + X2CLGraphicList; + +procedure Register; +begin + RegisterComponents('X²Software', [TX2GraphicContainer, TX2GraphicList]); +end; + +end. + \ No newline at end of file diff --git a/Source/X2CLGraphicList.pas b/Source/X2CLGraphicList.pas new file mode 100644 index 0000000..eadee0a --- /dev/null +++ b/Source/X2CLGraphicList.pas @@ -0,0 +1,649 @@ +{ + :: X2CLGraphicList contains a container component for TGraphic + :: descendants and a replacement for TImageList. + :: + :: Many thanks to Erik Stok. While I had the idea to create these components, + :: he created TPngImageList and worked out many of the problems I thought we + :: would face. His original (Dutch) article can be found at: + :: http://www.erikstok.net/delphi/artikelen/xpicons.html + :: + :: Last changed: $Date$ + :: Revision: $Rev$ + :: Author: $Author$ +} +unit X2CLGraphicList; + +interface +uses + Windows, + + Classes, + Controls, + Graphics; + +type + // Forward declarations + TX2GraphicList = class; + TX2GraphicContainer = class; + + { + :$ Holds a single graphic. + } + TX2GraphicCollectionItem = class(TCollectionItem, IChangeNotifier) + private + FPicture: TPicture; + + procedure SetPicture(const Value: TPicture); + protected + function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; + function _AddRef(): Integer; stdcall; + function _Release(): Integer; stdcall; + + procedure NotifierChanged(); + procedure IChangeNotifier.Changed = NotifierChanged; + public + constructor Create(Collection: TCollection); override; + destructor Destroy(); override; + published + property Picture: TPicture read FPicture write SetPicture; + end; + + { + :$ Holds a collection of graphics. + } + TX2GraphicCollection = class(TCollection) + private + FContainer: TX2GraphicContainer; + + function GetItem(Index: Integer): TX2GraphicCollectionItem; + procedure SetItem(Index: Integer; Value: TX2GraphicCollectionItem); + protected + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override; + procedure Update(Item: TCollectionItem); override; + public + constructor Create(const AContainer: TX2GraphicContainer); + + function Add(): TX2GraphicCollectionItem; + + property Items[Index: Integer]: TX2GraphicCollectionItem read GetItem + write SetItem; default; + end; + + { + :$ Container object for graphics. + + :: TX2GraphicContainer holds all the original graphic data. Link a container + :: to a TX2GraphicList to provide the graphics for various components. + } + TX2GraphicContainer = class(TComponent) + private + FGraphics: TX2GraphicCollection; + + FLists: TList; + + procedure SetGraphics(const Value: TX2GraphicCollection); + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); virtual; + procedure Update(Item: TCollectionItem); virtual; + + procedure RegisterList(const AList: TX2GraphicList); + procedure UnregisterList(const AList: TX2GraphicList); + public + constructor Create(AOwner: TComponent); override; + destructor Destroy(); override; + published + property Graphics: TX2GraphicCollection read FGraphics write SetGraphics; + end; + + { + :$ Defines the various modes for drawing a larger image. + } + TX2GLStretchMode = (smCrop, smStretch); + + { + :$ ImageList replacement for graphics. + } + TX2GraphicList = class(TImageList) + private + FBackground: TColor; + FContainer: TX2GraphicContainer; + FStretchMode: TX2GLStretchMode; + + procedure SetBackground(const Value: TColor); + procedure SetContainer(const Value: TX2GraphicContainer); + procedure SetStretchMode(const Value: TX2GLStretchMode); + protected + procedure DefineProperties(Filer: TFiler); override; + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + + procedure CreateImage(const AIndex: Integer; var AImage, AMask: TBitmap); virtual; + procedure AddImage(const AIndex: Integer); virtual; + procedure UpdateImage(const AIndex: Integer); virtual; + procedure DeleteImage(const AIndex: Integer); virtual; + + procedure RebuildImages(); virtual; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy(); override; + + procedure Loaded(); override; + published + property Background: TColor read FBackground write SetBackground default clBtnFace; + property Container: TX2GraphicContainer read FContainer write SetContainer; + property StretchMode: TX2GLStretchMode read FStretchMode write SetStretchMode default smCrop; + end; + +implementation +uses + Dialogs, + ImgList, + SysUtils; + +type + PClass = ^TClass; + + PRGBTripleArray = ^TRGBTripleArray; + TRGBTripleArray = array[Word] of TRGBTriple; + + + +{=============== TX2GraphicCollectionItem + Initialization +========================================} +constructor TX2GraphicCollectionItem.Create; +begin + inherited; + + FPicture := TPicture.Create(); + FPicture.PictureAdapter := Self; +end; + +destructor TX2GraphicCollectionItem.Destroy; +begin + FreeAndNil(FPicture); + + inherited; +end; + + +function TX2GraphicCollectionItem.QueryInterface; +begin + if GetInterface(IID, Obj) then + Result := 0 + else + Result := E_NOINTERFACE; +end; + +function TX2GraphicCollectionItem._AddRef; +begin + Result := -1; +end; + +function TX2GraphicCollectionItem._Release; +begin + Result := -1; +end; + + +procedure TX2GraphicCollectionItem.NotifierChanged; +begin + Changed(False); +end; + +procedure TX2GraphicCollectionItem.SetPicture; +begin + FPicture.Assign(Value); +end; + + +{=================== TX2GraphicCollection + Item Management +========================================} +constructor TX2GraphicCollection.Create; +begin + inherited Create(TX2GraphicCollectionItem); + + FContainer := AContainer; +end; + + +function TX2GraphicCollection.Add; +begin + Result := TX2GraphicCollectionItem(inherited Add()); +end; + + +procedure TX2GraphicCollection.Notify; +begin + inherited; + + if Assigned(FContainer) then + FContainer.Notify(Item, Action); +end; + +procedure TX2GraphicCollection.Update; +begin + inherited; + + if Assigned(FContainer) then + FContainer.Update(Item); +end; + + +function TX2GraphicCollection.GetItem; +begin + Result := TX2GraphicCollectionItem(inherited GetItem(Index)); +end; + +procedure TX2GraphicCollection.SetItem; +begin + inherited SetItem(Index, Value); +end; + + +{==================== TX2GraphicContainer + Initialization +========================================} +constructor TX2GraphicContainer.Create; +begin + inherited; + + FGraphics := TX2GraphicCollection.Create(Self); + FLists := TList.Create(); +end; + +destructor TX2GraphicContainer.Destroy; +begin + FreeAndNil(FGraphics); + FreeAndNil(FLists); + + inherited; +end; + +procedure TX2GraphicContainer.Notification; +begin + if not Assigned(FLists) then + exit; + + if Operation = opRemove then + FLists.Remove(AComponent) + else + // In design-time, if a TX2GraphicList is added and it doesn't yet have + // a container, assign ourselves to it for lazy programmers (such as me :)) + if (Operation = opInsert) and (csDesigning in ComponentState) and + (AComponent is TX2GraphicList) and + (not Assigned(TX2GraphicList(AComponent).Container)) then + TX2GraphicList(AComponent).Container := Self; + + inherited; +end; + +procedure TX2GraphicContainer.Notify; +var + iList: Integer; + +begin + case Action of + cnAdded: + for iList := FLists.Count - 1 downto 0 do + TX2GraphicList(FLists[iList]).AddImage(Item.Index); + cnDeleting: + for iList := FLists.Count - 1 downto 0 do + TX2GraphicList(FLists[iList]).DeleteImage(Item.Index); + end; +end; + +procedure TX2GraphicContainer.Update; +var + iList: Integer; + +begin + if Assigned(Item) then + for iList := FLists.Count - 1 downto 0 do + TX2GraphicList(FLists[iList]).UpdateImage(Item.Index) + else + for iList := FLists.Count - 1 downto 0 do + TX2GraphicList(FLists[iList]).RebuildImages(); +end; + + +procedure TX2GraphicContainer.RegisterList; +begin + if FLists.IndexOf(AList) = -1 then + FLists.Add(AList); +end; + +procedure TX2GraphicContainer.UnregisterList; +begin + FLists.Remove(AList); +end; + + +procedure TX2GraphicContainer.SetGraphics; +begin + FGraphics.Assign(Value); +end; + + + +{========================= TX2GraphicList + Initialization +========================================} +constructor TX2GraphicList.Create; +begin + inherited; + + FBackground := clBtnFace; + FStretchMode := smCrop; +end; + +procedure TX2GraphicList.Loaded; +begin + inherited; + + RebuildImages(); +end; + + +destructor TX2GraphicList.Destroy; +begin + SetContainer(nil); + + inherited; +end; + + + +{========================= TX2GraphicList + Graphics +========================================} +procedure TX2GraphicList.CreateImage; + function DrawGraphic(const ADest: TCanvas; const AIndex: Integer): Boolean; + var + rDest: TRect; + + begin + Result := False; + if not Assigned(FContainer.Graphics[AIndex].Picture) then + exit; + + with FContainer.Graphics[AIndex].Picture do + begin + if (FStretchMode = smCrop) or + ((Width <= Self.Width) and (Height <= Self.Height)) then + ADest.Draw(0, 0, Graphic) + else + begin + rDest := Rect(0, 0, Width, Height); + if rDest.Right > Self.Width then + rDest.Right := Self.Width; + + if rDest.Bottom > Self.Height then + rDest.Bottom := Self.Height; + + ADest.StretchDraw(rDest, Graphic); + end; + end; + + Result := True; + end; + + function RGBTriple(const AColor: TColor): TRGBTriple; + var + cColor: Cardinal; + + begin + cColor := ColorToRGB(AColor); + + with Result do + begin + rgbtBlue := GetBValue(cColor); + rgbtGreen := GetGValue(cColor); + rgbtRed := GetRValue(cColor); + end; + end; + + function SameColor(const AColor1, AColor2: TRGBTriple): Boolean; + begin + Result := CompareMem(@AColor1, @AColor2, SizeOf(TRGBTriple)); + end; + +var + bmpCompare: TBitmap; + bOk: Boolean; + cImage: TRGBTriple; + cMask: TRGBTriple; + iBit: Integer; + iPosition: Integer; + iX: Integer; + iY: Integer; + pCompare: PRGBTripleArray; + pImage: PRGBTripleArray; + pMask: PByteArray; + +begin + // Technique used here: draw the image twice, once on the background color, + // once on black. Loop through the two images, check if a pixel is the + // background color on one image and black on the other; if so then it's + // fully transparent. This doesn't eliminate all problems with alpha images, + // but it's the best option (at least for pre-XP systems). + // + // Note that components using ImageList.Draw will have full alpha support, + // this routine only ensures compatibility with ImageList_Draw components. + // TMenu is among the first, TToolbar and similar are amongst the latter. + with AImage do + begin + Width := Self.Width; + Height := Self.Height; + PixelFormat := pf24bit; + + with Canvas do + begin + Brush.Color := FBackground; + FillRect(Rect(0, 0, Width, Height)); + bOk := DrawGraphic(Canvas, AIndex); + end; + end; + + with AMask do + begin + Width := Self.Width; + Height := Self.Height; + PixelFormat := pf1bit; + + with Canvas do + begin + Brush.Color := clBlack; + FillRect(Rect(0, 0, Width, Height)); + end; + end; + + // No point in looping through the + // images if they're blank anyways... + if not bOk then + exit; + + bmpCompare := TBitmap.Create(); + try + with bmpCompare do + begin + Width := Self.Width; + Height := Self.Height; + PixelFormat := pf24bit; + + with Canvas do + begin + Brush.Color := clBlack; + FillRect(Rect(0, 0, Width, Height)); + DrawGraphic(Canvas, AIndex); + end; + end; + + cImage := RGBTriple(FBackground); + cMask := RGBTriple(clBlack); + + for iY := 0 to AImage.Height - 1 do + begin + pImage := AImage.ScanLine[iY]; + pCompare := bmpCompare.ScanLine[iY]; + pMask := AMask.ScanLine[iY]; + iPosition := 0; + iBit := 128; + + for iX := 0 to AImage.Width - 1 do + begin + if iBit = 128 then + pMask^[iPosition] := 0; + + if SameColor(pImage^[iX], cImage) and + SameColor(pCompare^[iX], cMask) then + begin + // Transparent pixel + FillChar(pImage^[iX], SizeOf(TRGBTriple), $00); + pMask^[iPosition] := pMask^[iPosition] or iBit; + end; + + iBit := iBit shr 1; + if iBit < 1 then + begin + iBit := 128; + Inc(iPosition); + end; + end; + end; + finally + FreeAndNil(bmpCompare); + end; +end; + +procedure TX2GraphicList.AddImage; +var + bmpImage: TBitmap; + bmpMask: TBitmap; + +begin + if csLoading in ComponentState then + exit; + + bmpImage := TBitmap.Create(); + bmpMask := TBitmap.Create(); + try + CreateImage(AIndex, bmpImage, bmpMask); + Assert(AIndex <= Self.Count, 'AAAH! Images out of sync! *panics*'); + + if AIndex = Self.Count then + Add(bmpImage, bmpMask) + else + Insert(AIndex, bmpImage, bmpMask); + finally + FreeAndNil(bmpMask); + FreeAndNil(bmpImage); + end; +end; + +procedure TX2GraphicList.UpdateImage; +var + bmpImage: TBitmap; + bmpMask: TBitmap; + +begin + if csLoading in ComponentState then + exit; + + bmpImage := TBitmap.Create(); + bmpMask := TBitmap.Create(); + try + CreateImage(AIndex, bmpImage, bmpMask); + Replace(AIndex, bmpImage, bmpMask); + finally + FreeAndNil(bmpMask); + FreeAndNil(bmpImage); + end; +end; + +procedure TX2GraphicList.DeleteImage; +begin + Delete(AIndex); +end; + + +procedure TX2GraphicList.RebuildImages; +var + iIndex: Integer; + +begin + if (csLoading in ComponentState) or + (Width = 0) or (Height = 0) then + exit; + + Clear(); + + if not Assigned(FContainer) then + exit; + + for iIndex := 0 to FContainer.Graphics.Count - 1 do + AddImage(iIndex); +end; + + +{========================= TX2GraphicList + Properties +========================================} +procedure TX2GraphicList.DefineProperties; +var + pType: TClass; + +begin + // TCustomImageList defines the Bitmap property, we don't want that + // (since the ImageList will be generated from a GraphicContainer). + // Erik's solution was to override Read/WriteData, but in Delphi 6 those + // aren't virtual yet. Instead we skip TCustomImageList's DefineProperties. + // + // The trick here is to modify the ClassType so the VMT of descendants + // (include ourself!) is ignored and only TComponent.DefineProperties + // is called... + pType := Self.ClassType; + PClass(Self)^ := TComponent; + try + DefineProperties(Filer); + finally + PClass(Self)^ := pType; + end; +end; + +procedure TX2GraphicList.Notification; +begin + if (Operation = opRemove) and (AComponent = FContainer) then + FContainer := nil; + + inherited; +end; + + +procedure TX2GraphicList.SetBackground; +begin + FBackground := Value; + RebuildImages(); +end; + +procedure TX2GraphicList.SetContainer; +begin + if Assigned(FContainer) then + FContainer.UnregisterList(Self); + + FContainer := Value; + + if Assigned(FContainer) then + FContainer.RegisterList(Self); + + RebuildImages(); +end; + +procedure TX2GraphicList.SetStretchMode; +begin + FStretchMode := Value; + RebuildImages(); +end; + +end. diff --git a/X2CL.bpg b/X2CL.bpg new file mode 100644 index 0000000..7ac795c --- /dev/null +++ b/X2CL.bpg @@ -0,0 +1,23 @@ +#------------------------------------------------------------------------------ +VERSION = BWS.01 +#------------------------------------------------------------------------------ +!ifndef ROOT +ROOT = $(MAKEDIR)\.. +!endif +#------------------------------------------------------------------------------ +MAKE = $(ROOT)\bin\make.exe -$(MAKEFLAGS) -f$** +DCC = $(ROOT)\bin\dcc32.exe $** +BRCC = $(ROOT)\bin\brcc32.exe $** +#------------------------------------------------------------------------------ +PROJECTS = X2CLGL.bpl X2CLGLD.bpl +#------------------------------------------------------------------------------ +default: $(PROJECTS) +#------------------------------------------------------------------------------ + +X2CLGL.bpl: Packages\D6\X2CLGL.dpk + $(DCC) + +X2CLGLD.bpl: Packages\D6\X2CLGLD.dpk + $(DCC) + +