unit uImageConvertEditor;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs,
Vcl.StdCtrls,
Vcl.ComCtrls,
Vcl.ExtCtrls;
type
TfrmImageConvertEditor =
class(TForm)
lvImages: TListView;
lblTitle: TLabel;
btnSave: TButton;
btnCancel: TButton;
ImagePreview: TImage;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure lvImagesSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure btnSaveClick(Sender: TObject);
private
{ Private-Deklarationen }
ImageInfo : TStringList;
ValidProperties : TStringList;
FRootComponent: TComponent;
procedure FillValidProperties;
function GetBitmap(AData : TObject) : TBitmap;
procedure SaveImages;
function IsValidProperty(APropName :
string) : boolean;
procedure ProcessComponents(AParent : TComponent;
var APath :
string);
procedure GetImageProperties(AComponent : TComponent;
const APath :
string);
procedure ShowImages;
public
constructor Create(AOwner: TComponent; ARootComponent : TComponent);
reintroduce;
end;
var
frmImageConvertEditor: TfrmImageConvertEditor;
implementation
uses
RTTI, TypInfo;
{$R *.dfm}
procedure TfrmImageConvertEditor.FormDestroy(Sender: TObject);
begin
ImageInfo.Free;
ValidProperties.Free;
end;
function TfrmImageConvertEditor.GetBitmap(AData: TObject): TBitmap;
begin
if AData
is TBitmap
then
result := TBitmap(AData)
else
if AData
is TPicture
then
begin
result := TPicture(AData).Bitmap;
end
else
result :=
nil;
end;
procedure TfrmImageConvertEditor.GetImageProperties(AComponent: TComponent;
const APath :
string);
var
LRtCo : TRttiContext;
LRtTyp : TRttiType;
LRtProp : TRttiProperty;
LPicture : TBitmap;
begin
LRtCo := TRttiContext.Create;
LRtTyp := LRtCo.GetType(AComponent.ClassType);
for LRtProp
in LRtTyp.GetProperties
do
begin
if LRtProp.IsReadable
and LRtProp.IsWritable
then
begin
if IsValidProperty(LRtProp.Parent.
Name + '
.' +LRtProp.
Name)
then
begin
LPicture := TBitmap(LRtProp.GetValue(AComponent).AsObject);
ImageInfo.AddObject(APath +
AComponent.
Name + '
.' +
LRtProp.
Name +
'
: ' + AComponent.ClassName,
LPicture);
end;
end;
end;
LRtCo.Free;
end;
function TfrmImageConvertEditor.IsValidProperty(APropName:
string): boolean;
begin
result := ValidProperties.IndexOf(APropName) >= 0;
end;
procedure TfrmImageConvertEditor.lvImagesSelectItem(Sender: TObject;
Item: TListItem; Selected: Boolean);
var
LBitmap : TBitmap;
begin
ImagePreview.Picture.Bitmap :=
nil;
if Selected
then
begin
LBitmap := GetBitmap(Item.Data);
if Assigned(LBitmap)
then
ImagePreview.Picture.Bitmap.Assign(LBitmap);
end;
end;
procedure TfrmImageConvertEditor.ProcessComponents(AParent : TComponent;
var APath :
string);
procedure AddPath;
begin
APath := APath + AParent.
Name + '
.';
end;
procedure RemovePath;
begin
APath := copy(APath, 1, length(APath) - length(AParent.
Name)-1);
end;
var
i : integer;
begin
if (AParent <>
nil)
and (AParent <> Self)
then
begin
GetImageProperties(AParent, APath);
AddPath;
for i := 0
to AParent.ComponentCount-1
do
begin
ProcessComponents(AParent.Components[i], APath);
end;
RemovePath;
end;
end;
procedure TfrmImageConvertEditor.SaveImages;
var
LBitmap : TBitmap;
i : integer;
begin
for i := 0
to ImageInfo.Count -1
do
begin
LBitmap := GetBitmap(ImageInfo.Objects[i]);
if Assigned(LBitmap)
and (LBitmap.Width > 0)
then
begin
LBitmap.PixelFormat := pf32bit;
// Zur Demonstration "Durchstreichen". Hier kann man natürlich
// beliebige Sauereien anstellen
// LBitmap.Canvas.Pen.Width := 2;
// LBitmap.Canvas.Pen.Color := clred;
// LBitmap.Canvas.MoveTo(0, 0);
// LBitmap.Canvas.LineTo(LBitmap.Width, LBitmap.Height);
end;
end;
end;
procedure TfrmImageConvertEditor.ShowImages;
var
i : integer;
LItem : TListItem;
DataBitmap : TBitmap;
SmallBitmap : TBitmap;
LargeBitmap : TBitmap;
begin
for i := 0
to ImageInfo.Count -1
do
begin
DataBitmap := GetBitmap(ImageInfo.Objects[i]);
LItem := lvImages.Items.Add;
LItem.Data := DataBitmap;
LItem.Caption := ImageInfo[i];
if Assigned(DataBitmap)
then
begin
try
SmallBitmap := TBitmap.Create;
SmallBitmap.Width := 16;
SmallBitmap.Height := 16;
SmallBitmap.Canvas.StretchDraw(Rect(0,0,16,16), DataBitmap);
LargeBitmap := TBitmap.Create;
LargeBitmap.Width := 64;
LargeBitmap.Height := 64;
LargeBitmap.Canvas.StretchDraw(Rect(0,0,64,64), DataBitmap);
lvImages.SmallImages.AddMasked(SmallBitmap, clFuchsia);
lvImages.LargeImages.AddMasked(LargeBitmap, clFuchsia);
LItem.ImageIndex := lvImages.SmallImages.Count-1;
LItem.SubItems.Add(Format('
%d x %d', [DataBitmap.Width, DataBitmap.Height]));
LItem.SubItems.Add(GetEnumName(TypeInfo(TPixelFormat), Integer(DataBitmap.PixelFormat)));
except
end;
end;
end;
end;
procedure TfrmImageConvertEditor.btnSaveClick(Sender: TObject);
begin
SaveImages;
end;
constructor TfrmImageConvertEditor.Create(AOwner, ARootComponent: TComponent);
begin
inherited Create(AOwner);
FRootComponent := ARootComponent;
end;
procedure TfrmImageConvertEditor.FillValidProperties;
begin
ValidProperties.Add('
TSpeedButton.Glyph');
ValidProperties.Add('
TBitBtn.Glyph');
ValidProperties.Add('
TImage.Picture');
end;
procedure TfrmImageConvertEditor.FormCreate(Sender: TObject);
var
ARootPath :
string;
begin
lvImages.SmallImages := TImageList.Create(
nil);
lvImages.LargeImages := TImageList.Create(
nil);
ImageInfo := TStringList.Create;
ValidProperties := TStringList.Create;
FillValidProperties;
ARootPath := '
';
ProcessComponents(FRootComponent, ARootPath);
ShowImages;
end;
end.