Advanced Delphi Systems Code: ads

//Advanced Delphi Systems Code: ads_GraphicStrings

unit ads_GraphicStrings;
{Copyright(c)2016 Advanced Delphi Systems

 Richard Maley
 Advanced Delphi Systems
 12613 Maidens Bower Drive
 Potomac, MD 20854 USA
 phone 301-840-1554
 dickmaley@advdelphisys.com

 The code herein can be used or modified by anyone.  Please retain references
 to Richard Maley at Advanced Delphi Systems.  If you make improvements to the
 code please send your improvements to dickmaley@advdelphisys.com so that the
 entire Delphi community can benefit.  All comments are welcome.
}

(*
Description: ads_GraphicStrings
This unit contains functions for converting
graphic images to and from strings.  The string
format is the same as that which is used by dfm
files.
*)

(*

UnitIndex Master Index Implementation Section Download Units

Description: ads_GraphicStrings.pas
This unit contains the following routines.

BitmapToString_ads ComponentToString GlyphToString_ads ImageListToString_ads PictureToString_ads StringToBitmap_ads StringToComponent StringToGlyph_ads StringToIcon_ads StringToImageList_ads StringToPicture_ads TBitmap_ads.SetBitmap TIcon_ads.SetIcon TImageList_ads.SetImageList TPicture_ads.SetPicture

*)
interface
Uses Graphics, Controls;

Function BitmapToString_ads(Bitmap: TBitmap): String;
Function StringToBitmap_ads(Bitmap: TBitmap; BitmapString: String): Boolean;
Function PictureToString_ads(Picture: TPicture): String;
Function StringToPicture_ads(Picture: TPicture; PictureString: String): Boolean;
Function GlyphToString_ads(Glyph: TBitmap): String;
Function StringToGlyph_ads(Glyph: TBitmap; GlyphString: String): Boolean;
Function StringToIcon_ads(Icon: TIcon; IconString: String): Boolean;

Function ImageListToString_ads(ImageList: TImageList): String;
Function StringToImageList_ads(Var ImageList: TImageList; ImageListString: String): Boolean;



implementation

Uses
  Classes,
  SysUtils,
  Dialogs,
  ads_Exception;

Var
  UnitName : String;
  ProcName : String;

Type
  TIcon_ads = Class(TComponent)
  private
    FIcon: TIcon;
    procedure SetIcon(const Value: TIcon);
  public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  published
    property Icon : TIcon read FIcon write SetIcon;
  End;

constructor TIcon_ads.Create(AOwner: TComponent);
begin
  ProcName  := 'TIcon_ads.Create'; Try
  inherited;
  FIcon := TIcon.Create();
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

destructor TIcon_ads.Destroy;
begin
  ProcName  := 'TIcon_ads.Destroy'; Try
  Try FIcon.Free; Except End;
  inherited;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

procedure TIcon_ads.SetIcon(const Value: TIcon);
begin
  ProcName  := 'TIcon_ads.SetIcon'; Try
  If FIcon <> Value Then FIcon := Value;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

Type
  TBitmap_ads = Class(TComponent)
  private
    FBitmap: TBitmap;
    procedure SetBitmap(const Value: TBitmap);
  public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  published
    property Bitmap : TBitmap read FBitmap write SetBitmap;
  End;

constructor TBitmap_ads.Create(AOwner: TComponent);
begin
  ProcName  := 'TBitmap_ads.Create'; Try
  inherited;
  FBitmap := TBitmap.Create();
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

destructor TBitmap_ads.Destroy;
begin
  ProcName  := 'TBitmap_ads.Destroy'; Try
  Try FBitmap.Free; Except End;
  inherited;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

procedure TBitmap_ads.SetBitmap(const Value: TBitmap);
begin
  ProcName  := 'TBitmap_ads.SetBitmap'; Try
  If FBitmap <> Value Then FBitmap := Value;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

Type
  TPicture_ads = Class(TComponent)
  private
    FPicture: TPicture;
    procedure SetPicture(const Value: TPicture);
  public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  published
    property Picture : TPicture read FPicture write SetPicture;
  End;

constructor TPicture_ads.Create(AOwner: TComponent);
begin
  ProcName  := 'TPicture_ads.Create'; Try
  inherited;
  FPicture := TPicture.Create();
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

destructor TPicture_ads.Destroy;
begin
  ProcName  := 'TPicture_ads.Destroy'; Try
  Try FPicture.Free; Except End;
  inherited;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

procedure TPicture_ads.SetPicture(const Value: TPicture);
begin
  ProcName  := 'TPicture_ads.SetPicture'; Try
  If FPicture <> Value Then FPicture := Value;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

function ComponentToString(Component: TComponent): string;
var
  BinStream: TMemoryStream;
  StrStream: TStringStream;
  s        : string;
begin
  ProcName  := 'ComponentToString'; Try
  BinStream := TMemoryStream.Create;
  try
    StrStream := TStringStream.Create(s);
    try
      BinStream.WriteComponent(Component);
      BinStream.Seek(0, soFromBeginning);
      ObjectBinaryToText(BinStream, StrStream);
      StrStream.Seek(0, soFromBeginning);
      Result:= StrStream.DataString;
    finally
      StrStream.Free;
    end;
  finally
    BinStream.Free
  end;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

function StringToComponent(Value: string): TComponent;
var
  StrStream:TStringStream;
  BinStream: TMemoryStream;
begin
  Result    := nil;
  ProcName  := 'StringToComponent'; Try
  StrStream := TStringStream.Create(Value);
  try
    BinStream := TMemoryStream.Create;
    try
      ObjectTextToBinary(StrStream, BinStream);
      BinStream.Seek(0, soFromBeginning);
      Result := BinStream.ReadComponent(nil);
    finally
      BinStream.Free;
    end;
  finally
    StrStream.Free;
  end;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

Function BitmapToString_ads(Bitmap: TBitmap): String;
Var
  Bitmap_ads : TBitmap_ads;
Begin
  ProcName  := 'BitmapToString_ads'; Try
  Bitmap_ads := TBitmap_ads.Create(nil);
  Try
    Bitmap_ads.Bitmap.Assign(Bitmap);
    Result := ComponentToString(Bitmap_ads);
  Finally
    Bitmap_ads.Free;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function StringToBitmap_ads(Bitmap: TBitmap; BitmapString: String): Boolean;
Var
  Bitmap_ads : TBitmap_ads;
  Image      : TBitmap;
Begin
  Result := True;
  ProcName  := 'StringToBitmap_ads'; Try
  Try
    Bitmap_ads := TBitmap_ads.Create(nil);
    Image      := TBitmap.Create();
    Try
      Bitmap_ads := TBitmap_ads(StringToComponent(BitmapString));
      Image.Assign(Bitmap_ads.Bitmap);
      Bitmap.Assign(Image);
    Finally
      Bitmap_ads.Free;
      Image.Free;
    End;
  Except
    Result := False;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function PictureToString_ads(Picture: TPicture): String;
Var
  Picture_ads : TPicture_ads;
Begin
  ProcName  := 'PictureToString_ads'; Try
  Picture_ads := TPicture_ads.Create(nil);
  Try
    Picture_ads.Picture.Assign(Picture);
    Result := ComponentToString(Picture_ads);
  Finally
    Picture_ads.Free;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function StringToPicture_ads(Picture: TPicture; PictureString: String): Boolean;
Var
  Picture_ads     : TPicture_ads;
  Image           : TPicture;
Begin
  Result          := True;
  ProcName  := 'StringToPicture_ads'; Try
  Try
    Picture_ads   := TPicture_ads.Create(nil);
    Image         := TPicture.Create();
    Try
      Picture_ads := TPicture_ads(StringToComponent(PictureString));
      Image.Assign(Picture_ads.Picture);
      Picture.Assign(Image);
    Finally
      Picture_ads.Free;
      Image.Free;
    End;
  Except
    Result := False;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function GlyphToString_ads(Glyph: TBitmap): String;
Begin
  ProcName  := 'GlyphToString_ads'; Try
  Result := BitmapToString_ads(Glyph);
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function StringToGlyph_ads(Glyph: TBitmap; GlyphString: String): Boolean;
Begin
  Result    := False;
  ProcName  := 'StringToGlyph_ads'; Try
  Result    := StringToBitmap_ads(Glyph,GlyphString);
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function StringToIcon_ads(Icon: TIcon; IconString: String): Boolean;
Var
  Icon_ads        : TIcon_ads;
  Image           : TIcon;
Begin
  Result          := True;
  ProcName  := 'StringToIcon_ads'; Try
  Try
    Icon_ads      := TIcon_ads.Create(nil);
    Image         := TIcon.Create();
    Try
      Icon_ads    := TIcon_ads(StringToComponent(IconString));
      Image.Assign(Icon_ads.Icon);
      Icon.Assign(Image);
    Finally
      Icon_ads.Free;
      Image.Free;
    End;
  Except
    Result := False;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

Type
  TImageList_ads = Class(TComponent)
  private
    FImageList: TImageList;
    procedure SetImageList(const Value: TImageList);
  public
    Constructor Create(AOwner: TComponent); Override;
    Destructor Destroy; Override;
  published
    property ImageList : TImageList read FImageList write SetImageList;
  End;

constructor TImageList_ads.Create(AOwner: TComponent);
begin
  ProcName  := 'TImageList_ads.Create'; Try
  inherited;
  FImageList := TImageList.Create(nil);
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

destructor TImageList_ads.Destroy;
begin
  ProcName  := 'TImageList_ads.Destroy'; Try
  Try FImageList.Free; Except End;
  inherited;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

procedure TImageList_ads.SetImageList(const Value: TImageList);
begin
  ProcName  := 'TImageList_ads.SetImageList'; Try
  If FImageList <> Value Then FImageList := Value;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
end;

//

Unit Description UnitIndex Master Index

Function ImageListToString_ads(ImageList: TImageList): String;
Var
  ImageList_ads : TImageList_ads;
Begin
  ProcName  := 'ImageListToString_ads'; Try
  ImageList_ads := TImageList_ads.Create(nil);
  Try
    ImageList_ads.ImageList.Assign(ImageList);
    Result := ComponentToString(ImageList_ads);
  Finally
    ImageList_ads.Free;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

//

Unit Description UnitIndex Master Index

Function StringToImageList_ads(Var ImageList: TImageList; ImageListString: String): Boolean;
Var
  ImageList_ads : TImageList_ads;
  Image         : TImageList;
Begin
  Result := True;
  ProcName  := 'StringToImageList_ads'; Try
  Try
    ImageList_ads := TImageList_ads.Create(nil);
    Image         := TImageList.Create(nil);
    Try
      ImageList_ads := TImageList_ads(StringToComponent(ImageListString));
      //Image.Assign(ImageList_ads.ImageList);
      //ImageList.Assign(Image);
      //ImageList := ImageList_ads.ImageList;
      //ImageList.Assign(ImageList_ads.ImageList);
      ImageList := TImageList(StringToComponent(ImageListString));
    Finally
      ImageList_ads.Free;
      Image.Free;
    End;
  Except
    Result := False;
  End;
  Except On E : Exception Do RaiseError(UnitName,ProcName,E); End;
End;

Initialization
  UnitName := 'ads_GraphicStrings';
  ProcName := 'Unknown';
  RegisterClasses([TBitmap_ads,TPicture_ads,TIcon_ads,TImageList_ads, TImageList]);
end.


//