1
0
mirror of synced 2024-11-23 18:43:49 +00:00

Fixed: always convert images in design-time

Fixed: dynamically added images on a graphiclist with Convert=False would result in an incorrect count
Fixed: container item tracks container's FreeNotification
Fixed: checks for invalid pointers (solves some AV's)
This commit is contained in:
Mark van Renswoude 2009-02-25 10:54:20 +00:00
parent 2ac4754fa6
commit a2b063801c
10 changed files with 257 additions and 193 deletions

View File

@ -32,6 +32,6 @@
-M
-$M16384,1048576
-K$00400000
-N"..\..\Lib\D7"
-LE"..\..\Lib\D7"
-LN"..\..\Lib\D7"
-N"P:\algemeen\lib"
-LE"P:\algemeen\bin"
-LN"P:\algemeen\bin"

View File

@ -91,9 +91,9 @@ ImageBase=4194304
ExeDescription=X²CL GraphicList
[Directories]
OutputDir=
UnitOutputDir=..\..\Lib\D7
PackageDLLOutputDir=..\..\Lib\D7
PackageDCPOutputDir=..\..\Lib\D7
UnitOutputDir=$(DELPHILIB)
PackageDLLOutputDir=$(DELPHIBIN)
PackageDCPOutputDir=$(DELPHIBIN)
SearchPath=
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
Conditionals=
@ -135,7 +135,8 @@ ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
P:\Algemeen\components\X2CL\Lib\D7\X2CLGLD.bpl=X²CL GraphicList (Designtime)
P:\algemeen\bin\X2CLGLD.bpl=X²CL GraphicList (Designtime)
P:\Algemeen\bin\unageneral_d7_design.bpl=UnameIT's General Components - Design-time Editors
C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
[HistoryLists\hlUnitAliases]
Count=1
@ -144,14 +145,18 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
Count=1
Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System
[HistoryLists\hlUnitOutputDirectory]
Count=3
Item0=..\..\Lib\D7
Item1=..\Lib\D7
Item2=Lib\D7
Count=4
Item0=$(DELPHILIB)
Item1=..\..\Lib\D7
Item2=..\Lib\D7
Item3=Lib\D7
[HistoryLists\hlBPLOutput]
Count=2
Item0=..\..\Lib\D7
Item1=Lib\D7
Count=3
Item0=$(DELPHIBIN)
Item1=..\..\Lib\D7
Item2=Lib\D7
[HistoryLists\hlDCPOutput]
Count=1
Item0=..\..\Lib\D7
Count=3
Item0=$(DELPHIBIN)
Item1=$(DELPHILIB)
Item2=..\..\Lib\D7

View File

@ -32,6 +32,6 @@
-M
-$M16384,1048576
-K$00400000
-N"..\..\Lib\D7"
-LE"..\..\Lib\D7"
-LN"..\..\Lib\D7"
-N"P:\algemeen\lib\D7"
-LE"P:\algemeen\bin\D7"
-LN"P:\algemeen\bin\D7"

View File

@ -91,9 +91,9 @@ ImageBase=4194304
ExeDescription=X²CL GraphicList (Designtime)
[Directories]
OutputDir=
UnitOutputDir=..\..\Lib\D7
PackageDLLOutputDir=..\..\Lib\D7
PackageDCPOutputDir=..\..\Lib\D7
UnitOutputDir=$(DELPHILIB)
PackageDLLOutputDir=$(DELPHIBIN)
PackageDCPOutputDir=$(DELPHIBIN)
SearchPath=
Packages=vcl;rtl;dbrtl;vcldb;vclx;dss;dsnapcrba;dsnapcon;inetdb;webdsnap;websnap;dbxcds;Irc;parsdpk;hotspotter
Conditionals=
@ -105,10 +105,6 @@ HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
@ -135,8 +131,9 @@ ProductName=
ProductVersion=1.0.0.0
Comments=
[Excluded Packages]
P:\algemeen\bin\X2CLGLD.bpl=X²CL GraphicList (Designtime)
P:\Algemeen\bin\unageneral_d7_design.bpl=UnameIT's General Components - Design-time Editors
C:\Program Files\Borland\Indy\D7\dclIndy70.bpl=Internet Direct (Indy) for D7 Property and Component Editors
C:\Program Files\madCollection\madExcept\Delphi 7\madExceptIde_.bpl=madExceptIde 1.1 - www.madshi.net
[HistoryLists\hlUnitAliases]
Count=1
Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
@ -144,14 +141,18 @@ Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
Count=1
Item0=P:\Algemeen\Indy10;P:\Algemeen\Indy10\Core;P:\Algemeen\Indy10\Protocols;P:\Algemeen\Indy10\SuperCore;P:\Algemeen\Indy10\System
[HistoryLists\hlUnitOutputDirectory]
Count=3
Item0=..\..\Lib\D7
Item1=..\Lib\D7
Item2=Lib\D7
Count=4
Item0=$(DELPHILIB)
Item1=..\..\Lib\D7
Item2=..\Lib\D7
Item3=Lib\D7
[HistoryLists\hlBPLOutput]
Count=2
Item0=..\..\Lib\D7
Item1=Lib\D7
Count=3
Item0=$(DELPHIBIN)
Item1=..\..\Lib\D7
Item2=Lib\D7
[HistoryLists\hlDCPOutput]
Count=1
Item0=..\..\Lib\D7
Count=3
Item0=$(DELPHIBIN)
Item1=$(DELPHILIB)
Item2=..\..\Lib\D7

View File

@ -31,9 +31,9 @@
-M
-$M16384,1048576
-K$00400000
-N"P:\algemeen\lib"
-LE"P:\algemeen\bin"
-LN"P:\algemeen\lib"
-N"P:\algemeen\lib\D7"
-LE"P:\algemeen\bin\D7"
-LN"P:\algemeen\lib\D7"
-Z
-w-UNSAFE_TYPE
-w-UNSAFE_CODE

View File

@ -105,10 +105,6 @@ HostApplication=
Launcher=
UseLauncher=0
DebugCWD=
[Language]
ActiveLang=
ProjectLang=
RootDir=C:\Program Files\Borland\Delphi7\Bin\
[Version Info]
IncludeVerInfo=1
AutoIncBuild=0
@ -154,6 +150,7 @@ Item0=$(DELPHIBIN)
Item1=..\..\Lib\D7
Item2=Lib\D7
[HistoryLists\hlDCPOutput]
Count=2
Item0=$(DELPHILIB)
Item1=..\..\Lib\D7
Count=3
Item0=$(DELPHIBIN)
Item1=$(DELPHILIB)
Item2=..\..\Lib\D7

View File

@ -7,6 +7,7 @@
:: 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$
@ -27,6 +28,12 @@ uses
{$WARN UNSAFE_TYPE OFF}
{$ENDIF}
{$IFDEF VER180}
{$WARN UNSAFE_CODE OFF}
{$WARN UNSAFE_CAST OFF}
{$WARN UNSAFE_TYPE OFF}
{$ENDIF}
type
// Forward declarations
@ -49,28 +56,30 @@ type
FPicture: TPicture;
FPictureName: String;
function GetIndex(): Integer;
function GetIndex: Integer;
procedure SetContainer(const Value: TX2GraphicContainer);
procedure SetIndex(const Value: Integer);
procedure SetPicture(const Value: TPicture);
procedure SetPictureName(const Value: String);
protected
procedure Changed(); virtual;
procedure Changed; virtual;
procedure InternalSetContainer(const AContainer: TX2GraphicContainer); virtual;
function GenerateName(): String;
function GenerateName: String;
procedure NotifierChanged();
procedure NotifierChanged;
procedure IChangeNotifier.Changed = NotifierChanged;
procedure ReadState(Reader: TReader); override;
procedure SetParentComponent(AParent: TComponent); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
destructor Destroy; override;
function GetParentComponent(): TComponent; override;
function HasParent(): Boolean; override;
function GetParentComponent: TComponent; override;
function HasParent: Boolean; override;
procedure AssignTo(Dest: TPersistent); override;
public
@ -93,7 +102,7 @@ type
FGraphics: TList;
FLists: TList;
function GetGraphicCount(): Integer;
function GetGraphicCount: Integer;
function GetGraphics(Index: Integer): TX2GraphicContainerItem;
procedure SetGraphics(Index: Integer; const Value: TX2GraphicContainerItem);
protected
@ -120,9 +129,9 @@ type
property Lists: TList read FLists;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
destructor Destroy; override;
procedure Clear();
procedure Clear;
function IndexByName(const AName: String): Integer;
function GraphicByName(const AName: String): TX2GraphicContainerItem;
@ -178,18 +187,21 @@ type
procedure DeleteImage(const AIndex: Integer); virtual;
procedure MoveImage(const AOldIndex, ANewIndex: Integer); virtual;
procedure RebuildImages(); virtual;
function CanConvert: Boolean;
procedure BeginUpdate();
procedure EndUpdate();
procedure UpdateImageCount; virtual;
procedure RebuildImages; virtual;
procedure BeginUpdate;
procedure EndUpdate;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy(); override;
destructor Destroy; override;
procedure AssignTo(Dest: TPersistent); override;
procedure Loaded(); override;
procedure Change(); override;
procedure Loaded; override;
procedure Change; override;
published
property Background: TColor read FBackground write SetBackground default clBtnFace;
property Container: TX2GraphicContainer read FContainer write SetContainer;
@ -205,6 +217,7 @@ type
implementation
uses
CommCtrl,
Forms,
ImgList,
SysUtils;
@ -232,7 +245,7 @@ type
procedure SetPicture(const Value: TPicture);
public
constructor Create(Collection: TCollection); override;
destructor Destroy(); override;
destructor Destroy; override;
published
property Name: String read FName write FName;
property Picture: TPicture read FPicture write SetPicture;
@ -288,12 +301,12 @@ constructor TX2GraphicContainerItem.Create(AOwner: TComponent);
begin
inherited;
FPicture := TPicture.Create();
FPicture := TPicture.Create;
FPicture.PictureAdapter := Self;
end;
destructor TX2GraphicContainerItem.Destroy();
destructor TX2GraphicContainerItem.Destroy;
begin
if Assigned(Container) then
Container.RemoveGraphic(Self);
@ -317,20 +330,38 @@ begin
end;
procedure TX2GraphicContainerItem.NotifierChanged();
procedure TX2GraphicContainerItem.NotifierChanged;
begin
Changed();
Changed;
end;
procedure TX2GraphicContainerItem.Notification(AComponent: TComponent; Operation: TOperation);
begin
if (Operation = opRemove) and (AComponent = FContainer) then
FContainer := nil;
inherited;
end;
procedure TX2GraphicContainerItem.InternalSetContainer(const AContainer: TX2GraphicContainer);
begin
if AContainer <> FContainer then
begin
if Assigned(FContainer) then
FContainer.RemoveFreeNotification(Self);
FContainer := AContainer;
if Assigned(FContainer) then
FContainer.FreeNotification(Self);
end;
end;
procedure TX2GraphicContainerItem.Changed();
procedure TX2GraphicContainerItem.Changed;
begin
if Assigned(Container) then
Container.UpdateGraphic(Self);
@ -338,21 +369,21 @@ end;
function TX2GraphicContainerItem.GetParentComponent(): TComponent;
function TX2GraphicContainerItem.GetParentComponent: TComponent;
begin
if Assigned(Container) then
Result := Container
else
Result := inherited GetParentComponent();
Result := inherited GetParentComponent;
end;
function TX2GraphicContainerItem.HasParent(): Boolean;
function TX2GraphicContainerItem.HasParent: Boolean;
begin
if Assigned(Container) then
Result := True
else
Result := inherited HasParent();
Result := inherited HasParent;
end;
@ -361,19 +392,20 @@ procedure TX2GraphicContainerItem.ReadState(Reader: TReader);
begin
inherited;
if Reader.Parent is TX2GraphicContainer then
if Assigned(Reader.Parent) and (Reader.Parent is TX2GraphicContainer) then
Container := TX2GraphicContainer(Reader.Parent);
end;
procedure TX2GraphicContainerItem.SetParentComponent(AParent: TComponent);
begin
if not (csLoading in ComponentState) and (AParent is TX2GraphicContainer) then
if (not (csLoading in ComponentState)) and
Assigned(AParent) and (AParent is TX2GraphicContainer) then
Container := TX2GraphicContainer(AParent);
end;
function TX2GraphicContainerItem.GetIndex(): Integer;
function TX2GraphicContainerItem.GetIndex: Integer;
begin
Result := -1;
if Assigned(Container) then
@ -392,7 +424,7 @@ begin
Value.AddGraphic(Self);
if not (csLoading in ComponentState) then
Name := GenerateName();
Name := GenerateName;
end;
end;
@ -416,12 +448,12 @@ begin
FPictureName := Value;
if not (csLoading in ComponentState) then
Name := GenerateName();
Name := GenerateName;
end;
end;
function TX2GraphicContainerItem.GenerateName(): String;
function TX2GraphicContainerItem.GenerateName: String;
function ValidComponentName(const AComponent: TComponent; const AName: String): Boolean;
var
checkOwner: TComponent;
@ -486,14 +518,14 @@ constructor TX2GraphicContainer.Create(AOwner: TComponent);
begin
inherited;
FGraphics := TList.Create();
FLists := TList.Create();
FGraphics := TList.Create;
FLists := TList.Create;
end;
destructor TX2GraphicContainer.Destroy();
destructor TX2GraphicContainer.Destroy;
begin
Clear();
Clear;
FreeAndNil(FGraphics);
FreeAndNil(FLists);
@ -551,7 +583,7 @@ begin
if Dest is TX2GraphicContainer then
begin
destContainer := TX2GraphicContainer(Dest);
destContainer.Clear();
destContainer.Clear;
for graphicIndex := 0 to Pred(Self.GraphicCount) do
with TX2GraphicContainerItem.Create(destContainer) do
@ -566,10 +598,10 @@ end;
procedure TX2GraphicContainer.Clear();
procedure TX2GraphicContainer.Clear;
begin
while GraphicsList.Count > 0 do
TX2GraphicContainerItem(GraphicsList.Last).Free();
TX2GraphicContainerItem(GraphicsList.Last).Free;
end;
@ -608,7 +640,7 @@ begin
begin
{ Re-generate names for graphic components }
for graphicIndex := 0 to Pred(GraphicCount) do
Graphics[graphicIndex].Name := Graphics[graphicIndex].GenerateName();
Graphics[graphicIndex].Name := Graphics[graphicIndex].GenerateName;
end;
end;
@ -797,7 +829,7 @@ end;
function TX2GraphicContainer.GetGraphicCount(): Integer;
function TX2GraphicContainer.GetGraphicCount: Integer;
begin
Result := GraphicsList.Count;
end;
@ -830,24 +862,24 @@ begin
end;
procedure TX2GraphicList.Loaded();
procedure TX2GraphicList.Loaded;
begin
inherited;
RebuildImages();
RebuildImages;
end;
procedure TX2GraphicList.Change();
procedure TX2GraphicList.Change;
begin
inherited;
if FUpdateCount = 0 then
RebuildImages();
RebuildImages;
end;
destructor TX2GraphicList.Destroy();
destructor TX2GraphicList.Destroy;
begin
SetContainer(nil);
@ -909,7 +941,7 @@ function TX2GraphicList.DrawGraphic(const AIndex: Integer;
case FStretchMode of
smCrop:
begin
bmpTemp := TBitmap.Create();
bmpTemp := TBitmap.Create;
try
with bmpTemp do
begin
@ -954,7 +986,8 @@ begin
if (AIndex < 0) or (AIndex >= FContainer.GraphicCount) then
exit;
if (not Assigned(FContainer.Graphics[AIndex].Picture.Graphic)) or
if (not Assigned(FContainer.Graphics[AIndex].Picture)) or
(not Assigned(FContainer.Graphics[AIndex].Picture.Graphic)) or
(FContainer.Graphics[AIndex].Picture.Graphic.Empty) then
exit;
@ -971,8 +1004,8 @@ begin
generic way of determining a pixel's transparency. So instead, we
blend the background with a copy of the background with the graphic
painted on it... }
bmpBackground := TBitmap.Create();
bmpBlend := TBitmap.Create();
bmpBackground := TBitmap.Create;
bmpBlend := TBitmap.Create;
try
{ Get background from canvas }
with bmpBackground do
@ -1061,17 +1094,6 @@ var
pMask: PByteArray;
begin
if not FConvert then
begin
AImage.Width := Self.Width;
AImage.Height := Self.Height;
AImage.Canvas.Brush.Color := clWhite;
AImage.Canvas.FillRect(Rect(0, 0, AImage.Width, AImage.Height));
AMask.Assign(AImage);
exit;
end;
// 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
@ -1113,7 +1135,7 @@ begin
if not bOk then
exit;
bmpCompare := TBitmap.Create();
bmpCompare := TBitmap.Create;
try
with bmpCompare do
begin
@ -1176,10 +1198,12 @@ begin
if csLoading in ComponentState then
exit;
BeginUpdate();
if CanConvert then
begin
BeginUpdate;
try
bmpImage := TBitmap.Create();
bmpMask := TBitmap.Create();
bmpImage := TBitmap.Create;
bmpMask := TBitmap.Create;
try
BuildImage(AIndex, bmpImage, bmpMask);
Assert(AIndex <= Self.Count, 'AAAH! Images out of sync! *panics*');
@ -1193,8 +1217,10 @@ begin
FreeAndNil(bmpImage);
end;
finally
EndUpdate();
EndUpdate;
end;
end else
UpdateImageCount;
end;
@ -1207,13 +1233,16 @@ begin
if csLoading in ComponentState then
exit;
if not CanConvert then
Exit;
if (AIndex < 0) or (AIndex >= Count) then
exit;
BeginUpdate();
BeginUpdate;
try
bmpImage := TBitmap.Create();
bmpMask := TBitmap.Create();
bmpImage := TBitmap.Create;
bmpMask := TBitmap.Create;
try
BuildImage(AIndex, bmpImage, bmpMask);
Replace(AIndex, bmpImage, bmpMask);
@ -1222,55 +1251,77 @@ begin
FreeAndNil(bmpImage);
end;
finally
EndUpdate();
EndUpdate;
end;
end;
procedure TX2GraphicList.DeleteImage(const AIndex: Integer);
begin
BeginUpdate();
BeginUpdate;
try
Delete(AIndex);
finally
EndUpdate();
EndUpdate;
end;
end;
procedure TX2GraphicList.MoveImage(const AOldIndex, ANewIndex: Integer);
begin
BeginUpdate();
BeginUpdate;
try
Move(AOldIndex, ANewIndex);
finally
EndUpdate();
EndUpdate;
end;
end;
procedure TX2GraphicList.RebuildImages();
procedure TX2GraphicList.UpdateImageCount;
begin
if not Assigned(Container) then
Clear
else
ImageList_SetImageCount(Self.Handle, Container.GraphicCount);
end;
procedure TX2GraphicList.RebuildImages;
var
iIndex: Integer;
begin
if (csLoading in ComponentState) or
(Width = 0) or (Height = 0) then
exit;
Exit;
BeginUpdate();
BeginUpdate;
try
Clear();
if not Assigned(FContainer) then
exit;
begin
Clear;
end else
begin
UpdateImageCount;
if CanConvert then
begin
for iIndex := 0 to Pred(FContainer.GraphicCount) do
AddImage(iIndex);
finally
EndUpdate();
UpdateImage(iIndex);
end;
end;
finally
EndUpdate;
inherited Change;
end;
end;
function TX2GraphicList.CanConvert: Boolean;
begin
Result := FConvert or (csDesigning in ComponentState);
end;
{========================= TX2GraphicList
@ -1312,7 +1363,7 @@ end;
procedure TX2GraphicList.SetBackground(const Value: TColor);
begin
FBackground := Value;
RebuildImages();
RebuildImages;
end;
@ -1332,7 +1383,7 @@ begin
FContainer.RegisterList(Self);
end;
RebuildImages();
RebuildImages;
end;
@ -1341,7 +1392,7 @@ begin
if Value <> FConvert then
begin
FConvert := Value;
RebuildImages();
RebuildImages;
end;
end;
@ -1349,24 +1400,24 @@ end;
procedure TX2GraphicList.SetEnabled(const Value: Boolean);
begin
FEnabled := Value;
RebuildImages();
RebuildImages;
end;
procedure TX2GraphicList.SetStretchMode(const Value: TX2GLStretchMode);
begin
FStretchMode := Value;
RebuildImages();
RebuildImages;
end;
procedure TX2GraphicList.BeginUpdate();
procedure TX2GraphicList.BeginUpdate;
begin
Inc(FUpdateCount);
end;
procedure TX2GraphicList.EndUpdate();
procedure TX2GraphicList.EndUpdate;
begin
Assert(FUpdateCount > 0, 'EndUpdate without matching BeginUpdate!');
Dec(FUpdateCount);
@ -1379,11 +1430,11 @@ constructor TDeprecatedGraphicItem.Create(Collection: TCollection);
begin
inherited;
FPicture := TPicture.Create();
FPicture := TPicture.Create;
end;
destructor TDeprecatedGraphicItem.Destroy();
destructor TDeprecatedGraphicItem.Destroy;
begin
FreeAndNil(FPicture);
@ -1397,7 +1448,6 @@ begin
end;
initialization
RegisterClass(TX2GraphicContainerItem);
CustomDrawImageProcs := TList.Create;

View File

@ -450,7 +450,7 @@ type
procedure SetSelectedItem(const Value: TX2CustomMenuBarItem);
protected
procedure CreateParams(var Params: TCreateParams); override;
procedure CreateHandle(); override;
procedure Loaded(); override;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure PainterUpdate(Sender: TX2CustomMenuBarPainter);
procedure GroupsNotify(Sender: TObject; Item: TCollectionItem; Action: TCollectionNotification);
@ -1432,7 +1432,7 @@ begin
end;
procedure TX2CustomMenuBar.CreateHandle();
procedure TX2CustomMenuBar.Loaded();
begin
inherited;

View File

@ -12,6 +12,7 @@ object frmMain: TfrmMain
Font.Style = []
OldCreateOrder = False
Position = poScreenCenter
OnClick = FormClick
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
@ -357,6 +358,7 @@ object frmMain: TfrmMain
end>
end>
Images = glMenu
TabOrder = 14
OnCollapsed = mbTestCollapsed
OnCollapsing = mbTestCollapsing
OnExpanded = mbTestExpanded

View File

@ -74,6 +74,7 @@ type
procedure seAnimationTimeChange(Sender: TObject);
procedure actTestExecute(Sender: TObject);
procedure actTest2Execute(Sender: TObject);
procedure FormClick(Sender: TObject);
private
procedure Event(const AMsg: String);
end;
@ -239,4 +240,12 @@ begin
Sleep(200);
end;
procedure TfrmMain.FormClick(Sender: TObject);
begin
if Assigned(ActiveControl) then
Self.Caption := ActiveControl.Name
else
Self.Caption := '';
end;
end.