Wie Image aus VCL-Formular-Datei (.dfm) auslesen

[Union]

Ich habe dafür eine Komponente erstellt. Die installiert sich unter Samples/TImageConverter. Die setzt man auf das Form mit den Controls, die Grafiken enthalten. Über das Kontextmenü der Komponente wählt man 'Images dieses Formulares bearbeiten' aus. Dann öffnet sich ein Dialog in dem die Komponenten angezeigt werden mit der Auflösung der Grafiken. Beim Klick auf "Speichern" werden alle Grafiken auf 32 bit Farbtiefe gesetzt. Danach ist die Komponente wieder zu entfernen und die evtl. eingefügte unit "ImageConvertEditor" aus den uses zu entfernen.

Die dpk:

Delphi-Quellcode:

package ImageConvertPackage;

{$R *.res}
{$R 'ImageConvertEditor.dcr'}
{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
{$ALIGN 8}
{$ASSERTIONS ON}
{$BOOLEVAL OFF}
{$DEBUGINFO OFF}
{$EXTENDEDSYNTAX ON}
{$IMPORTEDDATA ON}
{$IOCHECKS ON}
{$LOCALSYMBOLS OFF}
{$LONGSTRINGS ON}
{$OPENSTRINGS ON}
{$OPTIMIZATION ON}
{$OVERFLOWCHECKS OFF}
{$RANGECHECKS OFF}
{$REFERENCEINFO OFF}
{$SAFEDIVIDE OFF}
{$STACKFRAMES OFF}
{$TYPEDADDRESS OFF}
{$VARSTRINGCHECKS ON}
{$WRITEABLECONST OFF}
{$MINENUMSIZE 1}
{$IMAGEBASE $400000}
{$DEFINE RELEASE}
{$ENDIF IMPLICITBUILDING}
{$DESCRIPTION 'Image converter'}
{$DESIGNONLY}
{$IMPLICITBUILD ON}

requires
  rtl,
  vcl,
  designide;

contains
  ImageConvertEditor in 'ImageConvertEditor.pas',
  uImageConvertEditor in 'uImageConvertEditor.pas' {frmImageConvertEditor};

end.

Die Komponente, die nichts weiter macht als auf einen Doppelklick bzw, die Auswahl des Kontextmenüs zu reagieren:

Delphi-Quellcode:

unit ImageConvertEditor;


interface

uses System.Classes, DesignIntf, DesignEditors;

type

  TImageConvertEditor = class(TComponentEditor)
  public
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
    procedure ShowImageConvertEditor;
  private
    TheDesigner: DesignIntf.IDesigner;
  end;

  TImageConverter = class(TComponent)
  end;

procedure Register;

implementation

uses Dialogs, Forms, uImageConvertEditor;

{ TImageConvertEditor }
procedure TImageConvertEditor.ExecuteVerb(Index: Integer);
begin
  inherited;
  case Index of
  0 : ShowImageConvertEditor;
  end;
end;

function TImageConvertEditor.GetVerb(Index: Integer): string;
begin
  case Index of
  0 : result := 'Images dieses Formulares bearbeiten';
  end;
end;

function TImageConvertEditor.GetVerbCount: Integer;
begin
  result := 1;
end;

procedure TImageConvertEditor.ShowImageConvertEditor;
var
  frmConvertEditor: TFrmImageConvertEditor;
begin
  TheDesigner := Self.Designer;
  frmConvertEditor := TFrmImageConvertEditor.Create(Application, TheDesigner.CurrentParent);
  frmConvertEditor.ShowModal;
  frmConvertEditor.Free;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TImageConverter]);
  RegisterComponentEditor(TImageConverter, TImageConvertEditor);
end;

end.

Der Dialog und die Beasrbeitungslogik, die relevante Bearbeitung findet in SaveImages statt:

Delphi-Quellcode:

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.

Das Formular dazu:

Code:

object frmImageConvertEditor: TfrmImageConvertEditor
  Left = 0
  Top = 0
  Caption = 'Image Converter'
  ClientHeight = 277
  ClientWidth = 559
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poOwnerFormCenter
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  DesignSize = (
    559
    277)
  PixelsPerInch = 96
  TextHeight = 13
  object lblTitle: TLabel
    Left = 8
    Top = 8
    Width = 82
    Height = 13
    Caption = 'Gefundene Bilder'
  end
  object ImagePreview: TImage
    Left = 407
    Top = 148
    Width = 144
    Height = 121
    Anchors = [akRight, akBottom]
    Stretch = True
  end
  object lvImages: TListView
    Left = 8
    Top = 24
    Width = 393
    Height = 245
    Anchors = [akLeft, akTop, akRight, akBottom]
    Columns = <
      item
        AutoSize = True
        Caption = 'Komponente'
      end
      item
        AutoSize = True
        Caption = 'Gr'#246#223'e'
      end
      item
        AutoSize = True
        Caption = 'Format'
      end>
    TabOrder = 0
    ViewStyle = vsReport
    OnSelectItem = lvImagesSelectItem
  end
  object btnSave: TButton
    Left = 476
    Top = 22
    Width = 75
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Speichern'
    ModalResult = 1
    TabOrder = 1
    OnClick = btnSaveClick
  end
  object btnCancel: TButton
    Left = 476
    Top = 53
    Width = 75
    Height = 25
    Anchors = [akTop, akRight]
    Caption = 'Abbruch'
    ModalResult = 2
    TabOrder = 2
  end
end

RC (ImageConvertEditor.rc)für die Erstellung der dcr:

Code:

TIMAGECONVERTER16 BITMAP "Graphic design 16.bmp"
TIMAGECONVERTER BITMAP "Graphic design 24.bmp"
TIMAGECONVERTER32 BITMAP "Graphic design 32.bmp"

Dafür ist in den Projektoptionen als Pre-Build-Ereignis folgendes einzutragen:

Code:

brcc32 -fo"ImageConvertEditor.dcr" "ImageConvertEditor.rc"