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;
Kaum macht man's richtig - schon funktioniert's
Zertifikat: Sir Rufo (Fingerprint: ea 0a 4c 14 0d b6 3a a4 c1 c5 b9
dc 90 9d f0 e9 de 13 da 60)