Bereich eines Images zoomen

[Neutral General]

Hi,

Also auf diese Idee mit dem CodeLib Eintrag bin ich eigentlich nur durch folgenden Thread gekommen: *klick*

Naja ich rede nicht viel drum rum - Los gehts!

Beschreibung

Mit folgendem Code ist es möglich innerhalb einer TImage Komponente das Bild zu zoomen und zwar indem man mit der Maus

ein Rechteck zieht um den Bereich der vergrößert werden soll. Natürlich ist dieser Code auf jedes andere beliebige Bitmap das

nicht in einem Image angezeigt wird übertragbar.

Durchführung (1)

Ich würde sagen wir fangen damit an so ein "Markierungsrechteck" für unser Image zu bauen.

Dazu speichern wir die Koordinaten der Maus im OnMouseDown-Ereignis des Images in eine Variable und setzen eine Boolean

Variable auf true, was für uns soviel bedeutet wie: "Die Linke Maustaste wird gedrückt gehalten". Diese Variable erinnert uns

immer daran.

Delphi-Quellcode:

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := true;
  P.x    := x;
  P.y    := y;
end;

Natürlich müssen wir diese Variablen vorher deklarieren:

Delphi-Quellcode:

TForm1 = class(TForm)
   ...
  public
   IsDown: Boolean;
   P: TPoint;
end;

Wer möchte kann die Variablen natürlich auch global deklarieren und die Benennung ist natürlich auch nur ein Vorschlag

Jetzt gehen wir ins OnMouseUp Ereignis der Image Komponente und setzen IsDown wieder auf false, denn damit das der User

die Maustaste loslässt ist die Maustaste nicht mehr gedrückt und das müssen wir wissen (was für eine Logik )

Delphi-Quellcode:

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := false;
end;

Jetzt kommen wir zu dem MouseMove-Ereignis, denn wir wollen ja das sich diese Markierungsrechteck je nachdem wie wir die

Maus bewegen verändert. Außerdem haben wir es noch gar nicht gezeichnet!

Delphi-Quellcode:

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if IsDown then //Nur wenn Maustaste gedrückt ist!
  begin
   // Wenn man außerhalb des Bildes ist Koordinaten entsprechend anpassen
   if x < 0 then x := 0;                          
   if y < 0 then y := 0;
   if x > Image1.Width then x := Image1.Width; // Oder Image1.Picture.Bitmap.Width
   if y > Image1.Height then y:= Image1.Height; // Oder Image1.Picture.Bitmap.Height  (Unterschied wird erklärt)
   
   // Das Rechteck malen
   with Image1.Picture.Bitmap.Canvas do
   begin
    Pen.Style := psDot; // Keine Durchgezogene Linie sondern nur Pünktchen (Geschmackssache)
    Pen.Mode := pmnotXor; // Wird erklärt
    
    Rectangle(Old);  // das folgende auch
   // Rectangle(Old.Left,Old.Top,Old.Right,Old.Bottom); für Delphi <= 3
    Old := Rect(P.x,P.y,x,y); 
    Rectangle(P.x,P.y,x,y);
   end;
  end;
end;

Alsoo erstmal erscheint eine neue Variable namens 'Old'. Sie ist vom Typ TRect und sie wird wie alle anderen variablen entweder im public-Teil des Formulars oder global deklariert.

Pen.Mode := pmnotXor; Dieser Modus ermöglicht uns auf das Bitmap zu malen so das wir, wenn wir nochmal drübermalen, wieder das alte Bild haben. Wir wollen ja, das das Bild heil bleibt und wir die Markierungsrechtecke wieder wegbekommen

(Zur Erinnerung:

b := b xor x = b'
b' := b' xor x = b

Das heißt zweimal xor angewendet ergibt wieder das ursprüngliche

Binär:

Delphi-Quellcode:

// In der ersten Zeile wird Formatierung ignoriert -.-
    01011
xor 11010
  = 10001

    10001
xor 11010
  = 01011

=> Wir sind wieder bei der Ausgangszahl )

Rectangle(Old); Mit diesem Befehl übermalen wir zuerst das alte Rechteck

Old := Rect(P.x,P.y,x,y); Das neue "alte Rechteck" ist das was wir gleich zeichnen werden (und danach wieder überzeichnen werden)
Wobei P.x und P.y die x- bzw y-Koordinate von dem Punkt ist wo wir mit der Maus angesetzt haben und x und y sind die Koordinaten wo wir uns gerade befinden.

Rectangle(P.x,P.y,x,y); Jetzt malen wir unser Markierungsrechteck (Alternativ auch Rectangle(Old) aber das könnte eventuell bisschen Verwirrung stiften deswegen schreib ich das lieber so...)

Ausprobieren (1)

Man kann das jetzt schon ausprobieren
Es wird ein Markierungsrechteck gemalt das aber jedoch solange da bleibt bis man ein neues zieht.
Das wollen wir jetzt im nächsten Schritt abstellen.

Weiter gehts!

Wir erweitern das MouseUp Event des Images folgendermaßen:

Delphi-Quellcode:

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := false;
  Image1.Picture.Bitmap.Canvas.Rectangle(Old.Left,Old.Top,Old.Right,Old.Bottom); // Das letzte gemalte Rechteck wegradieren
  Old := Rect(0,0,0,0); // Das alte Rechteck zerstören (wir haben brauchen keins zu diesem Zeitpunkt)
end;

Also ich denke mal ich habe das meiste schon durch die Kommentare erklärt... Wer will kann ja die letze Zeile mal weglassen und gucken was passiert

Ausprobieren (2)
Ich würde sagen schauts euch mal an und spielt bisschen rum

Durchführung (2)
Unser Rechteck haben wir jetzt aber das Bild soll ja schließlich auch vergrößert werden. Das war ja eigentlich unser Ziel

Zuerst brauchen wir noch eine Variable vom Typ TRect. Nennt sie wie ihr wollt, ich nenne sie Rec

Erstmal wie auch eben brauchen wir die Koordinaten des Anfangspunktes wo der Benutzer die Maustaste runterdrückt.
Einfach im OnMouseDown Ereignise folgende beiden Zeilen ergänzen:

Delphi-Quellcode:

Rec.Left := x;
Rec.Top := y;

So wir wollen ja das wir erst ranzoomen wenn wir die Maustaste loslassen alsooo an was denken wir sofort? Richhtig => OnMouseUp.
Da fügen wir dann folgende Zeilen ein. (Erklärung als Kommentar + weiter unten)

Delphi-Quellcode:

  Rec.Bottom := y;
  Rec.Right := x;
  CorrectRect(Rec); // Rechteck korrigieren (procedure folgt)

  tmp := TBitmap.Create; // 'tmp' lokal als TBitmap deklarieren
  with tmp do
  begin
    Width := Image1.Picture.Bitmap.Width; // Niiiiemals vergessen *g*
    Height := Image1.Picture.Bitmap.Height;
    Canvas.CopyRect(Rect(0,0,Width,Height), // Hier erfolgt das eigentliche vergrößern
                    Image1.Picture.Bitmap.Canvas,
                    Rec);
    Image1.Picture.Bitmap := tmp; // Dem Bitmap von Image1 unser tmp Bitmap zuweisen.
    Free; // fertig (+ freigeben ;) )
  end;

Also zuerst Ergänzen wir die zwei fehlenden Koordinaten unseres Rec's (ersten beiden Zeilen) und korrigieren es (falls nötig..)
Danach erstellen wir uns ein Temporäres Bitmap (tmp) das wir genauso groß machen wie das Bild im Image.
Jetzt kommt der eigentliche Befehl zum vergrößern. Als erster Parameter wird die Fläsche festgesetzt auf der das neue Bild gemalt werden soll.. das ist in unserem Fall eindeutig die ganze Fläsche des Images. Der zweite Parameter gibt an von welchem Canvas der Bildausschnitt kopiert werden soll. Naja vom Canvas vom Bitmap von unserem Image würd ich mal sagen oder ?
Und der letzte Parameter gibt an welche Fläsche vom Originalbild auf das neue Bild gemalt werden soll.. Naja genau die Fläsche die wir mit unserem Markierungsrechteck markiert haben also Rec. Ich hoffe ich habe das einigermaßen verständlich erklärt grad Joa als letztes weißt man noch unser tmp Bitmap dem Image1.Picture.Bitmap zu und gibt das temporäre Bitmap frei.

So als allerletztes noch der Code für CorrectRect:

Delphi-Quellcode:

procedure TForm1.CorrectRect(var Rec: TRect);
var tmp: Integer;
begin
  if Rec.Right < Rec.Left then // Wenn Right weiter rechts liegt als Left 
  begin
    tmp := Rec.Right;  // dann vertauschen wir das 
    Rec.Right := Rec.Left;
    Rec.Left := tmp;
  end;
  if Rec.Top > Rec.Bottom then // Das gleiche bei Top und Bottom
  begin
    tmp := Rec.Top;
    Rec.Top := Rec.Bottom;
    Rec.Bottom := tmp;
  end;
end;

Am besten ist es wenn man die Procedure als Methode von TForm1 deklariert aber eine herrenlose procedure geht natürlich auch
Ich denke mir ansonsten brauche ich dazu nicht viel zu sagen. Falls doch was unklar ist dann fragt mich einfach (hier im Forum oder ICQ oder PN)

Ausprobieren (3) + Fertig
Naja wir sind fertig und es sollte eigentlich jetzt soweit alles funktionieren also würde ich sagen bester Zeitpunkt um es auszuprobieren

Und der gesamte Code:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private-Deklarationen }
  public
    IsDown: Boolean;
    P: TPoint;
    Old, Rec: TRect;
    procedure CorrectRect(var Rec: TRect);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CorrectRect(var Rec: TRect);
var tmp: Integer;
begin
  if Rec.Right < Rec.Left then
  begin
    tmp := Rec.Right;
    Rec.Right := Rec.Left;
    Rec.Left := tmp;
  end;
  if Rec.Top > Rec.Bottom then
  begin
    tmp := Rec.Top;
    Rec.Top := Rec.Bottom;
    Rec.Bottom := tmp;
  end;
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  IsDown := true;
  P.x := x;
  P.y := y;
  rec.Left := x;
  rec.Top := y;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var tmp: TBitmap;
begin
  IsDown := false;
  Image1.Picture.Bitmap.Canvas.Rectangle(Old)
 // Image1.Picture.Bitmap.Canvas.Rectangle(Old.Left,Old.Top,Old.Right,Old.Bottom);
  Old := Rect(0,0,0,0);

  Rec.Bottom := y;
  Rec.Right := x;
  CorrectRect(Rec); 

  tmp := TBitmap.Create; 
  with tmp do
  begin
    Width := Image1.Picture.Bitmap.Width;
    Height := Image1.Picture.Bitmap.Height;
    Canvas.CopyRect(Rect(0,0,Width, 
                    Height),
                    Image1.Picture.Bitmap.Canvas,Rec);
    Image1.Picture.Bitmap := tmp; 
    Free; 
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if IsDown then
  begin
   if x < 0 then x := 0;
   if y < 0 then y := 0;
   if x > Image1.Width then x := Image1.Width; 
   if y > Image1.Height then y:= Image1.Height;

   with Image1.Picture.Bitmap.Canvas do
   begin
    Pen.Style := psDot;
    Pen.Mode := pmnotXor;

    Rectangle(Old);
   // Rectangle(Old.Left,Old.Top,Old.Right,Old.Bottom);
    Old := Rect(P.x,P.y,x,y);
    Rectangle(P.X,P.y,x,y);
   end;
  end;
end;

end.

Viel Spaß

Bei Frage oder Verbesserungsvorschlägen wie gehabt einfach hier rein posten

Gruß
Neutral General


[edit=Matze]Beitrag aktualisiert. Mfg, Matze[/edit]