Bu unit program grafik string işleminde kullanılır.
Kod: Tümünü seç
unit ads_GraphicStrings;
{Copyright(c)2000 Advanced Delphi Systems
Richard Maley
Advanced Delphi Systems
12613 Maidens Bower Drive
Potomac, MD 20854 USA
phone 301-840-1554
maley@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 maley@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.
*)
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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;
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.