picturestore.pas

实现程序的图片资源存储管理的compoment

unit PictureStore;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, JPEG;

type
  TPictureStore = class;

  TPictureItem = class(TCollectionItem)
  protected
    FPicture : TPicture;
    FMemo : String;
    procedure SetPicture(Value : TPicture);
    procedure SetTransparent(Value : Boolean);
    function  GetTransparent : Boolean;
    function  GetDisplayName: String; override;
  public
    constructor Create(Collection: TCollection); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Picture : TPicture read FPicture write SetPicture;
    property Transparent : Boolean read GetTransparent write SetTransparent;
    property Memo : String read FMemo write FMemo;
  end;

  TPictures = class(TCollection)
  private
    FOBPictureStore: TPictureStore;
    function GetItem(Index: Integer): TPictureItem;
    procedure SetItem(Index: Integer; Value: TPictureItem);
  protected
    function GetOwner: TPersistent; override;
    procedure Update(Item: TCollectionItem); override;
  public
    constructor Create(lComponent : TPictureStore);
    function Add: TPictureItem;
    function AddItem(Item: TPictureItem; Index: Integer): TPictureItem;
    property Items[Index: Integer]: TPictureItem read GetItem write SetItem; default;
  end;

  TPictureStore = class(TComponent)
  private
    FAbout : String;
    FPictures : TPictures;
    procedure SetPictures(Value : TPictures);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property About : String read FAbout write FAbout;
    property Pictures : TPictures read FPictures write SetPictures;
  end;

procedure Register;

implementation

{ TPictureItem }

procedure Register;
begin
  RegisterComponents('Samples', [TPictureStore]);
end;

procedure TPictureItem.Assign(Source: TPersistent);
begin
  if Source is TPictureItem
     then Picture.Assign(TPictureItem(Source).Picture)
     else inherited Assign(Source);
end; { 存取图像 }

constructor TPictureItem.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FPicture := TPicture.Create;
end; { 创建列表 }

function TPictureItem.GetDisplayName: String;
begin
  if FPicture <> nil then
  if FPicture.Width <> 0 then
  begin
    if FPicture.Graphic is TBitmap then Result := 'BMP格式图像 ' else
    if FPicture.Graphic is TJpegImage then Result := 'JPEG格式图像 ' else
    if FPicture.Graphic is TIcon then Result := 'ICON格式图像 ' else
    if FPicture.Graphic is TMetafile then Result := 'METAFILE格式图像 ' else
    Result := Result + '其它格式图像 ';
    Result := Result + IntToStr(FPicture.Width)+' * '+IntToStr(FPicture.Height);
  end;
  if Result = '' then Result := '无图像...';
end; { 显示图像名称 }

function TPictureItem.GetTransparent: Boolean;
begin
  if FPicture.Width <> 0
     then Result := FPicture.Graphic.Transparent
     else Result := False;
end; { 图像透明设定 }

procedure TPictureItem.SetPicture(Value: TPicture);
begin
  if Value <> nil then
     FPicture.Assign(Value);
end; { 存取图像 }

procedure TPictureItem.SetTransparent(Value: Boolean);
begin
  if FPicture.Width <> 0
     then FPicture.Graphic.Transparent := Value;
end; { 设定图像透明 }

{ TPictures }

function TPictures.Add: TPictureItem;
begin
  Result := TPictureItem(inherited Add);
end; { 添加 }

function TPictures.AddItem(Item: TPictureItem;
  Index: Integer): TPictureItem;
begin
  Result := TPictureItem(inherited GetItem(Index));
end; { 添加子项 }

constructor TPictures.Create(lComponent: TPictureStore);
begin
  inherited Create(TPictureItem);
  FOBPictureStore := lComponent
end; { 创建列表 }

function TPictures.GetItem(Index: Integer): TPictureItem;
begin
  Result := TPictureItem(inherited GetItem(Index));
end; { 存取指定图像 }

function TPictures.GetOwner: TPersistent;
begin
  Result := FOBPictureStore;
end; { 取得父类 }

procedure TPictures.SetItem(Index: Integer; Value: TPictureItem);
begin
  inherited SetItem(Index, Value);
end; { 存取指定图像 }

procedure TPictures.Update(Item: TCollectionItem);
begin
  inherited;

end; { 更新指定图像 }

{ TPictureStore }

constructor TPictureStore.Create(AOwner: TComponent);
begin
  inherited;
  FPictures := TPictures.Create(Self);
end; { 创建控件 }

destructor TPictureStore.Destroy;
begin
  FPictures.Free;
  inherited;
end; { 取消控件 }

procedure TPictureStore.SetPictures(Value: TPictures);
begin
  FPictures.Assign(Value);
end; { 设置图像 }

end.