unit ImageMultiStates;
interface
uses
Vcl.Graphics,
Vcl.StdCtrls, System.SysUtils, System.Classes,
Vcl.Controls,
Vcl.ExtCtrls, Forms, Generics.Collections;
type
TPic =
class(TCollectionItem)
private
FPicture: TPicture;
procedure SetPicture(
const value: TPicture);
protected
function GetDisplayName:
String;
override;
public
procedure Assign(Source: TPersistent);
override;
constructor Create(Collection: TCollection);
override;
published
property Picture: TPicture
read FPicture
write SetPicture;
end;
TPictures =
class(TOwnedCollection)
private
function GetPic(
Index: Integer): TPic;
procedure SetPic(
Index: Integer; Value: TPic);
public
constructor Create(AOwner: TComponent);
destructor Destroy;
property Picture[
Index: Integer]: TPic
read GetPic
write SetPic;
end;
TImageMultiStates =
class(TImage)
private
FPictures: TPictures;
FOnMouseDownPic: Integer;
FOnMouseUpPic: Integer;
procedure SetPictures(
const Value: TPictures);
public
ActivePic: Integer;
constructor Create(AOwner: TComponent);
override;
destructor Destroy;
override;
procedure ActivatePic(
Index: Integer);
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
override;
published
property Pictures: TPictures
read FPictures
write SetPictures;
property OnMouseDownPic: Integer
read FOnMouseDownPic
write FOnMouseDownPic;
property OnMouseUpPic: Integer
read FOnMouseUpPic
write FOnMouseUpPic;
end;
procedure Register;
implementation
constructor TPic.Create(Collection: TCollection);
begin
inherited;
FPicture := TPicture.Create;
end;
procedure TPic.Assign(Source: TPersistent);
begin
if Source
is TPic
then
FPicture := TPic(Source).FPicture
else
inherited;
end;
procedure TPic.SetPicture(
const Value: TPicture);
begin
FPicture.Assign(Value);
if Index=0
then
TImageMultiStates(TPictures(GetOwner).GetOwner).Picture.Assign(Value);
end;
function TPic.GetDisplayName;
begin
Result := Format('
Picture %d',[
Index]);
end;
constructor TPictures.Create(AOwner: TComponent);
begin
inherited Create(AOwner, TPic);
end;
destructor TPictures.Destroy;
begin
inherited Destroy;
end;
procedure TPictures.SetPic(
Index: Integer; Value: TPic);
begin
inherited SetItem(
Index, Value);
end;
function TPictures.GetPic(
Index: Integer): TPic;
begin
Result :=
inherited GetItem(
Index)
as TPic;
end;
constructor TImageMultiStates.Create(AOwner: TComponent);
begin
inherited;
FOnMouseDownPic := -1;
FOnMouseUpPic := -1;
FPictures := TPictures.Create(AOwner);
end;
destructor TImageMultiStates.Destroy;
begin
FPictures.Free;
inherited;
end;
procedure TImageMultiStates.SetPictures(
const Value: TPictures);
begin
FPictures.Assign(Value);
end;
procedure TImageMultiStates.ActivatePic(
Index: Integer);
begin
if (
Index < FPictures.Count)
and (
Index >= 0)
then
begin
ActivePic :=
Index;
Picture.Assign(TPic(FPictures.Items[
Index]).FPicture);
end
else
begin
ActivePic := -1;
Picture.Assign(
nil);
end;
end;
procedure TImageMultiStates.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FOnMouseDownPic<>-1
then
Picture.Assign(TPic(FPictures.Items[FOnMouseDownPic]).FPicture);
inherited;
end;
procedure TImageMultiStates.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if FOnMouseUpPic<>-1
then
Picture.Assign(TPic(FPictures.Items[FOnMouseUpPic]).FPicture);
inherited;
end;
procedure Register;
begin
RegisterComponents('
Standard', [TImageMultiStates]);
end;
end.