Paintbox, Scrollbox und GDI

[Rainer Wolff]

Hallo,

ich schlage mich jetzt schon eine Weile mit den GDI-Funktionen zur Grafikausgabe herum. Ich will Vektorgrafiken (und auch WMF-Files) in einem Koordinatensystem ausgeben und das ganze auch zoomen.
Dazu will ich die Windows-Funktionen zur Skalierung benutzen. Selbst skalieren wollte ich nicht, da ich ausserdem noch Koordinatensystem und einzelne Grafiken spiegeln muss und daher schon vorhandenes aus dem GDI nutzen will.

Die Grafik selbst klappt auch inzwischen, aber jetzt will ich noch eine Scrollbox haben, um die vergrößerte Grafik zu scrollen (und danach natürlich noch per Maus verschieben).

Hier scheint mir jetzt irgendwo in den Systemtiefen meine Skalierung wieder einzugehen, denn wenn ich meine Grafik um den Faktor zwei vergrößere, bekomme ich nicht das erwartete Verhalten.

Ich habe eine kleine Demo angehängt, die demonstrieren soll, was ich meine.

Ich zeichne ein blaues Rechteck links in meinen Canvas, ein rotes ganz rechts.

Dann skaliere ich um den Faktor zwei. Das blaue Recheck erscheint korrekt vergrößert in der linken Bildhälfte. Wenn ich jetzt nach rechst scrolle, sollte doch eigentlich das rote Rechteck wieder ganz rechts am Rand erscheinen, zu sehen ist aber nur noch die rechte Seite des Rechtecks am linken Rand, und rechts davon noch viel leere Zeichenfläche.

Ich habe aber keine Idee, wo ich meine Scrollbox jetzt noch entsprechend korrigieren kann. Oder muss ich hier einzelne Scrollbars nehmen und selbst skalieren. Dann muss ich mir aber auch schon wieder den richtigen Ausschnitt aus meiner Paintbox auf den Bildschirm zaubern...

Wenn sich jemand fände, der in dem Bereich schon Erfahrungen gesammelt hat, wäre es nett.

Gruß Rainer

Delphi-Quellcode:

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    PaintBox1: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button2Click(Sender: TObject);
    procedure PaintBox1Paint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    scale: Integer;
    procedure PrepareCanvas(Canvas: TCanvas);
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button2Click(Sender: TObject);
begin
  scale:=scale*2;
  PaintBox1.Width:=PaintBox1.Width*2;
  PaintBox1.Height:=PaintBox1.Height*2;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  scale:=1;
end;

procedure TForm1.PrepareCanvas(Canvas: TCanvas);
begin
  SetGraphicsMode(canvas.handle, GM_ADVANCED);
  setMapMode(canvas.Handle, MM_ISOTROPIC);

  SetWindowExtEx(Canvas.Handle, Round(400), Round(300), nil);

  SetViewportExtEx(Canvas.Handle, round(400*scale), round(300*scale), nil);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
  preparecanvas(PaintBox1.Canvas);
  PaintBox1.Canvas.Pen.Color:=clBlue;
  PaintBox1.Canvas.Rectangle(10,10,100,100);
  PaintBox1.Canvas.Pen.Color:=clRed;
  PaintBox1.Canvas.Rectangle(300,10,399,100);
end;

[shmia]

Du rufst PrepareCanvas() bei jedem Paint-Event auf.
Einmal (in OnShow) sollte doch reichen...

[Rainer Wolff]

hm, dachte ich auch, daß ein Aufruf PrepareCanvas genügt. Aber irgendwann am Anfang der Entwicklung hatte ich gemerkt, dass ich den Aufruf jedesmal brauche. Seither habe ich das nicht mehr kontrolliert und so beibehalten. Das sollte aber mit meinem momentanen Problem nichts zu tun haben, denke ich.

[shmia]

Zitat:

Zitat von Rainer Wolff

Das sollte aber mit meinem momentanen Problem nichts zu tun haben, denke ich.

Mein Bauchgefühl sagt aber dass es der GDI nicht gut tut immer wieder mit setMapMode & Co bombadiert zu werden.
Und mein Bauchgefühl lässt mich selten im Stich. :wink:

[Rainer Wolff]

Versuchsweise hab ich jetzt mal den Preparecanvas aus dem OnPaint entfernt und nur im Create bzw. Zoom aufgerufen. Dann wird aber meine Grafik gar nicht mehr gezoomt.
Leider finden sich ja in dem Bereich verdammt wenige bis keine Beispiele.

Anbei die geänderte Version, nicht dass ich noch einen anderen Fehler drinhab.

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
begin
  scale:=scale div 2;
  preparecanvas(PaintBox1.Canvas);
  PaintBox1.Width:=PaintBox1.Width div 2;
  PaintBox1.Height:=PaintBox1.Height div 2;
  preparecanvas(PaintBox1.Canvas);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  scale:=scale*2;
  preparecanvas(PaintBox1.Canvas);
  PaintBox1.Width:=PaintBox1.Width*2;
  PaintBox1.Height:=PaintBox1.Height*2;
//  preparecanvas(PaintBox1.Canvas);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  scale:=1;
  preparecanvas(PaintBox1.Canvas);
end;

procedure TForm1.PrepareCanvas(Canvas: TCanvas);
begin
  SetGraphicsMode(PaintBox1.Canvas.handle, GM_ADVANCED);
  setMapMode(PaintBox1.Canvas.Handle, MM_ISOTROPIC);

  SetWindowExtEx(Canvas.Handle, Round(400), Round(300), nil);

  SetViewportExtEx(Canvas.Handle, round(400*scale), round(300*scale), nil);
end;

procedure TForm1.PaintBox1Paint(Sender: TObject);
begin
//  preparecanvas(PaintBox1.Canvas);
  PaintBox1.Canvas.Pen.Color:=clBlue;
  PaintBox1.Canvas.Rectangle(10,10,100,100);
  PaintBox1.Canvas.Pen.Color:=clRed;
  PaintBox1.Canvas.Rectangle(300,10,399,100);
end;

[shmia]

Delphi-Quellcode:

function TControl.GetDeviceContext(var WindowHandle: HWnd): HDC;
begin
  if Parent = nil then
    raise EInvalidOperation.CreateFmt(SParentRequired, [Name]);
  Result := Parent.GetDeviceContext(WindowHandle);
  SetViewportOrgEx(Result, Left, Top, nil);
  IntersectClipRect(Result, 0, 0, Width, Height);  // *****
end;

Ich vermute mal, die makierte Zeile macht dir einen Strich durch die Rechnung...

[Rainer Wolff]

Sieht sehr danach aus, hilft mir aber ned wirklich weiter :(