Suche Konzept: Bild mit unbekannter Größe

[Sir Rufo]

Bei einem Bitmap, muss man vorher auch die Größe angeben, sonst habe ich zwar auf dem Canvas gemalt, aber in der Bitmap steht nichts drin.

Somit hat man also mit dem Bitmap nichts gewonnen.

Ein simple Alternative besteht (wie schon gesagt) die Zeichenroutinen ein zusammenzustellen, dabei stellt man eben auch die tatsächliche Größe fest und dann wird das Zeil auf diese Größe eingestellt und die Zeichenroutinen angewendet.

Hier ein ganz billiges Beispiel:

Delphi-Quellcode:

unit Form.MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm1 = class( TForm )
    Button1: TButton;
    Button2: TButton;
    PaintBox1: TPaintBox;
    ScrollBox1: TScrollBox;
    Panel1: TPanel;
    procedure Button1Click( Sender: TObject );
    procedure Button2Click( Sender: TObject );
    procedure PaintBox1Paint( Sender: TObject );
  private
    FPaintBoxProc: TProc<TCanvas>;
    procedure SetPaintBoxProc( const Value: TProc<TCanvas> );
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click( Sender: TObject );
var
  LProc: TProc<TCanvas>;
begin
  // Zeichenroutine zusammenstellen
  LProc :=
    procedure( Canvas: TCanvas )
    begin
      Canvas.Brush.Color := clRed;
      Canvas.Ellipse( 100, 100, 400, 400 );
      Canvas.Brush.Color := clBlue;
      Canvas.Rectangle( 350, 400, 800, 700 );
    end;

  // PaintBox Größe setzen
  PaintBox1.Width := 800;
  PaintBox1.Height := 700;

  // Zeichenroutine für die PaintBox setzen
  SetPaintBoxProc( LProc );
end;

procedure TForm1.Button2Click( Sender: TObject );
begin
  SetPaintBoxProc( nil );
end;

procedure TForm1.PaintBox1Paint( Sender: TObject );
begin
  // Hier wird die Zeichenroutine einfach ausgeführt
  if Assigned( FPaintBoxProc ) then
    FPaintBoxProc( ( Sender as TPaintBox ).Canvas );
end;

procedure TForm1.SetPaintBoxProc( const Value: TProc<TCanvas> );
begin
  FPaintBoxProc := Value;
  if not Assigned( Value ) then
  begin
    PaintBox1.Height := 0;
    PaintBox1.Width := 0;
  end;
  PaintBox1.Invalidate;
end;

end.

Ein kleiner Hinweis sei noch gegeben:

Delphi-Quellcode:

type
  TProcUtil = class
    class function Combine<T>( Collection: TEnumerable < TProc < T >> ): TProc<T>; overload;
    class function Combine<T>( Values: TArray < TProc < T >> ): TProc<T>; overload;
  end;

{ TProcUtil }

class function TProcUtil.Combine<T>( Values: TArray < TProc < T >> ): TProc<T>;
begin
  Result :=
    procedure( Arg: T )
    var
      LProc: TProc<T>;
    begin
      for LProc in Values do
        LProc( Arg );
    end;
end;

class function TProcUtil.Combine<T>( Collection: TEnumerable < TProc < T >> ): TProc<T>;
begin
  Result := Combine<T>( Collection.ToArray );
end;