Delphi Template Image Wrapper

unit TemplateImg;

(*
  Template Image Component
  by Jerry Dodge

  Use the TTemplateImage component to encapsulate a single image
  to be used as a style template for various controls.

  Component can be installed into Delphi and designed in the IDE.

  Image is presumed to have a transparent color for a background
  matching that of the component's TransparentColor property.

  Load a template image using one of the LoadImage overloads.

  Regions of the image are accessible by Rect references by name.

  Use the Elements property to populate each possible region
  assigning both a unique name and rectangle bounds.

  Draw region on another canvas using one of the GetTemplate overloads.
*)

interface

uses
  Winapi.Windows, Winapi.Messages,
  System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Jpeg, Gif, PngImage;

type
  TTemplateItem = class(TCollectionItem)
  private
    FLeft: Integer;
    FTop: Integer;
    FRight: Integer;
    FBottom: Integer;
    FName: String;
    function GetHeight: Integer;
    function GetWidth: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  protected
    function GetDisplayName: String; override;
  public
    constructor Create(ACollection: TCollection);
    function Bounds: TRect;
    procedure SetBounds(R: TRect); overload;
    procedure SetBounds(ALeft, ATop, ARight, ABottom: Integer); overload;
  published
    property Name: String read FName write FName;
    property Left: Integer read FLeft write FLeft;
    property Top: Integer read FTop write FTop;
    property Right: Integer read FRight write FRight;
    property Bottom: Integer read FBottom write FBottom;
    property Width: Integer read GetWidth write SetWidth;
    property Height: Integer read GetHeight write SetHeight;
  end;

  TTemplateItems = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TTemplateItem;
    procedure SetItem(Index: Integer; const Value: TTemplateItem);
    function GetByName(Name: String): TTemplateItem;
    procedure SetByName(Name: String; const Value: TTemplateItem);
  public
    constructor Create(AOwner: TPersistent);
    function Add: TTemplateItem;
    function Insert(Index: Integer): TTemplateItem;
    procedure SaveToFile(const Filename: String);
    procedure LoadFromFile(const Filename: String);
    property Items[Index: Integer]: TTemplateItem read GetItem write SetItem; default;
    property ByName[Name: String]: TTemplateItem read GetByName write SetByName;
  end;

  TTemplateImage = class(TComponent)
  private
    FElements: TTemplateItems;
    FBmp: TBitmap;
    FTransparentColor: TColor;
    procedure SetTransparentColor(const Value: TColor);
    procedure SetElements(const Value: TTemplateItems);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Reset;
    procedure LoadImage(const Filename: String); overload;
    procedure LoadImage(Stream: TStream); overload;
    procedure GetTemplate(const Name: String; Dest: TCanvas; const X, Y: Integer); overload;
    procedure GetTemplate(const Name: String; Dest: TCanvas; const R: TRect); overload;
    function GetRect(const Name: String): TRect;
  published
    property TransparentColor: TColor
      read FTransparentColor write SetTransparentColor;
    property Elements: TTemplateItems read FElements write SetElements;
  end;


implementation

function RectToStr(const R: TRect): String;
begin
  Result:= IntToStr(R.Left);
  Result:= Result + ',' + IntToStr(R.Top);
  Result:= Result + ',' + IntToStr(R.Right);
  Result:= Result + ',' + IntToStr(R.Bottom);
end;

function StrToRect(const R: String): TRect;
var
  S, T: String;
  P: Integer;
begin
  S:= R;

  P:= Pos(',', S);
  T:= Copy(S, 1, P-1);
  Delete(S, 1, P);
  Result.Left:= StrToIntDef(T, 0);

  P:= Pos(',', S);
  T:= Copy(S, 1, P-1);
  Delete(S, 1, P);
  Result.Top:= StrToIntDef(T, 0);

  P:= Pos(',', S);
  T:= Copy(S, 1, P-1);
  Delete(S, 1, P);
  Result.Right:= StrToIntDef(T, 0);

  Result.Bottom:= StrToIntDef(S, 0);
end;

{ TTemplateItem }

function TTemplateItem.Bounds: TRect;
begin
  Result:= Rect(FLeft, FTop, FRight, FBottom);
end;

constructor TTemplateItem.Create(ACollection: TCollection);
begin
  inherited Create(ACollection);

end;

function TTemplateItem.GetDisplayName: String;
begin
  Result:= FName;
end;

function TTemplateItem.GetHeight: Integer;
begin
  Result:= FBottom - FTop;
end;

function TTemplateItem.GetWidth: Integer;
begin
  Result:= FRight - FLeft;
end;

procedure TTemplateItem.SetBounds(R: TRect);
begin
  FLeft:= R.Left;
  FTop:= R.Top;
  FRight:= R.Right;
  FBottom:= R.Bottom;
end;

procedure TTemplateItem.SetBounds(ALeft, ATop, ARight, ABottom: Integer);
begin
  FLeft:= ALeft;
  FTop:= ATop;
  FRight:= ARight;
  FBottom:= ABottom;
end;

procedure TTemplateItem.SetHeight(const Value: Integer);
begin
  FBottom:= FTop + Value;
end;

procedure TTemplateItem.SetWidth(const Value: Integer);
begin
  FRight:= FLeft + Value;
end;

{ TTemplateItems }

constructor TTemplateItems.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TTemplateItem);

end;

function TTemplateItems.Add: TTemplateItem;
begin
  Result:= TTemplateItem(inherited Add);
end;

function TTemplateItems.GetByName(Name: String): TTemplateItem;
var
  X: Integer;
begin
  for X := 0 to Count-1 do begin
    if SameText(Items[X].Name, Name) then begin
      Result:= Items[X];
      Break;
    end;
  end;
end;

function TTemplateItems.GetItem(Index: Integer): TTemplateItem;
begin
  Result:= TTemplateItem(inherited GetItem(Index));
end;

function TTemplateItems.Insert(Index: Integer): TTemplateItem;
begin
  Result:= TTemplateItem(inherited Insert(Index));
end;

procedure TTemplateItems.LoadFromFile(const Filename: String);
var
  L: TStringList;
  X: Integer;
  I: TTemplateItem;
  N: String;
begin
  L:= TStringList.Create;
  try
    Clear;
    L.LoadFromFile(Filename);
    for X := 0 to L.Count-1 do begin
      I:= Add;
      N:= L.Names[X];
      I.Name:= N;
      I.SetBounds(StrToRect(L.Values[N]));
    end;
  finally
    L.Free;
  end;
end;

procedure TTemplateItems.SaveToFile(const Filename: String);
var
  L: TStringList;
  X: Integer;
begin
  L:= TStringList.Create;
  try
    for X := 0 to Count - 1 do
      L.Values[Items[X].Name]:= RectToStr(Items[X].Bounds);
    L.SaveToFile(Filename);
  finally
    L.Free;
  end;
end;

procedure TTemplateItems.SetByName(Name: String; const Value: TTemplateItem);
var
  X: Integer;
begin
  for X := 0 to Count-1 do begin
    if SameText(Items[X].Name, Name) then begin
      Items[X]:= Value;
      Break;
    end;
  end;
end;

procedure TTemplateItems.SetItem(Index: Integer; const Value: TTemplateItem);
begin
  inherited SetItem(Index, Value);
end;

{ TTemplateImage }

constructor TTemplateImage.Create(AOwner: TComponent);
begin
  inherited;
  FElements:= TTemplateItems.Create(Self);
  FBmp:= TBitmap.Create;
  FBmp.Transparent:= True;
  TransparentColor:= clFuchsia;
end;

destructor TTemplateImage.Destroy;
begin
  FBmp.Free;
  FElements.Free;
  inherited;
end;

function TTemplateImage.GetRect(const Name: String): TRect;
var
  T: TTemplateItem;
begin
  T:= FElements.ByName[Name];
  if Assigned(T) then begin
    Result:= T.Bounds;
  end;
end;

procedure TTemplateImage.GetTemplate(const Name: String; Dest: TCanvas;
  const R: TRect);
var
  T: TTemplateItem;
begin
  T:= FElements.ByName[Name];
  if Assigned(T) then begin
    Dest.CopyRect(R, FBmp.Canvas, T.Bounds);
  end;
end;

procedure TTemplateImage.GetTemplate(const Name: String; Dest: TCanvas; const X, Y: Integer);
var
  T: TTemplateItem;
  DR: TRect;
begin
  T:= FElements.ByName[Name];
  if Assigned(T) then begin
    DR.Left:= X;
    DR.Top:= Y;
    DR.Width:= T.Width;
    DR.Height:= T.Height;
    Dest.CopyRect(DR, FBmp.Canvas, T.Bounds);
  end;
end;

procedure TTemplateImage.LoadImage(Stream: TStream);
var
  I: TWicImage;
begin
  I:= TWicImage.Create;
  try
    Stream.Position:= 0;
    I.LoadFromStream(Stream);
    FBmp.Assign(I);
  finally
    I.Free;
  end;
end;

procedure TTemplateImage.Reset;
begin
  FBmp.TransparentColor:= FTransparentColor;
end;

procedure TTemplateImage.LoadImage(const Filename: String);
var
  I: TWicImage;
begin
  I:= TWicImage.Create;
  try
    I.LoadFromFile(Filename);
    FBmp.Assign(I);
  finally
    I.Free;
  end;
end;

procedure TTemplateImage.SetElements(const Value: TTemplateItems);
begin
  FElements.Assign(Value);
end;

procedure TTemplateImage.SetTransparentColor(const Value: TColor);
begin
  FTransparentColor:= Value;
  FBmp.TransparentColor:= Value;
end;

end.