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

[Harry Stahl]

Zitat von Bernhard Geyer:

Das müsste ich dann man mit einem eigenen Delphi und einer Vollständigen Hexwert (in einem Beispielformular) nachvollziehen.

Grundsätzlich noch mal der Hinweis, dass Du recht hattest, es wird tatsächlich dort die Größe gespeichert. Was mich gerade ein wenig irritiert ist, dass die Bitmaps im .BMP-Foprmat unterschiedliche Größen haben können, bei gleichem Ausmaß und gleicher Bittiefe.

Ich habe hier mal ein Formular hochgeladen und die beiden verwendeten Bitmaps.

[himitsu]

Die Idee einfach mal in TPicture.WriteData, TPicture.ReadData, TBitmap.WriteData und TBitmap.ReadData reinzuschauen hatte noch Keiner?

Auf die Idee dort reinzugucken, wäre man gekommen, wenn man in TPicture.DefineProperties und TGraphic.DefineProperties geschaut hätte.

[Harry Stahl]

Danke, guter Hinweis.

[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"

[Harry Stahl]

Wow, Union, ich bin beeindruckt, was Du da an Arbeit reingesteckt hast. Ist ein interessanter Ansatz und demonstriert einige interessante Techniken im Rahmen der Komponentenentwicklung (wovon ich leider nur sehr wenig Ahnung habe).

Ich habe es nun so gelöst, dass ich die Informationen zu allen Grafiken, die in einer VCL-Form sind, in einen Dialog einlese und habe diesen Dialog aber in mein Bildbearbeitungsprogramm eingebunden (habe dafür nun einen extra zu aktivierenden "Entwicklermodus" integriert, denn ein normaler Mensch braucht so etwas ja nicht).

So kann bei den Bildern nicht nur die Bit-Tiefe ändern, sondern eben alles das, was man mit einem Bildbearbeitungsprogramm machen kann. Änderungen kann ich dann einzeln oder für alle geänderten Bilder zurückschreiben.

Habe mal einen Screenshot des aktuellen Zustands des Dialogs angehängt. Wenn ich das fertig habe, poste ich noch mal eine Info dazu.

[Union]

Du kannst ja in der Komponente den Aufruf Deines Dialoges einbauen. Der darf dann natürlich keine Abhängigkeiten haben. Das wäre dann der Entwickler modus.

[Harry Stahl]

Zitat von Union:

Du kannst ja in der Komponente den Aufruf Deines Dialoges einbauen.

Danke für das Angebot. Jedoch passt das leider nicht so insgesamt in den Ablauf, den ich hier vorgesehen habe. Ich will ja von extern auf die DFM-Datei zugreifen und nicht jedes mal für diesen Prozess eine Komponente einbauen. Außerdem will ich noch viel mehr mit den Grafiken machen können.

Vielleicht wird das alles ein wenig mehr verständlich, wenn man es in einem kurzen Video sieht. Obwohl die Funktion noch nicht fertig ist, habe ich diese als BETA gekennzeichnet in die aktuelle Version 6.19 von PixPower eingebunden und in meinem PixPower-Channel ein kurzes Video dazu hinterlegt.

Das könnt Ihr Euch hier ansehen:

http://youtu.be/_xDzDkmVqM8

[Harry Stahl]

Da das Einlesen der TImageList hier noch nicht 100% funktioniert (Delphi verwendet hier wohl eine Maskengrafik, um Transparenz darzustellen), habe ich noch mal eine weitere Möglichkeit gezeigt, um an die Bilder aus der TImageList zu gelangen und ALLE enthaltenen Grafiken in einem Rutsch zu exportieren und dann als einzelne Grafiken speichern zu können. So kann man mit 5 Minuten Aufwand seine bisherige ImageList unter FMX weiterverwenden oder die Grafiken sonst anderweitig verwenden.

Hier der Link zu diesem Video:

http://youtu.be/XNJSrbLV9x8

[Bernhard Geyer]

Zitat von Harry Stahl:

Da das Einlesen der TImageList hier noch nicht 100% funktioniert (Delphi verwendet hier wohl eine Maskengrafik, um Transparenz darzustellen), ...

Delphi verlässt sich AFAIK hier teilweise auf die WinApi so das die Problem u.U. hierher kommen könnten.

[Union]

Nicht nur teilweise: Die Imagelist kapselt ein CommonControl. Der interne Aufbau der Daten ist damit u.U. sogar abhängig von der installierten Version des IE