Hi,
ich habe ein Bild in einem Image , dass Image ist aber kleiner als das Bild und
Image1.Stretch ist auf false. Wenn ich jetzt die Maus drücke möchte ich das bild verschieben
ich habe hier im Forum auch schon Threads gefunden aber ich kein konkretes beispiel
wie man das Bild mit Image1.Canvas.CopyRect verschieben kann .
Mfg ReDoX

Du lädst das Bild in ein Bitmap und speicherst die Bildkoordinaten. Im OnMouseDown speicherst du die Mauskoordinaten, im OnMouseMove addierst du die Differenz zwischen alten und neuen Koordinaten zu den Bildkoordinaten dazu. Ggf. im OnPaint nochmals von Bitmap zu Image kopieren.

Ja aber ich suche ein konkretes Beispiel ,ich stehe auf dem Schlauch....
Als wenn jemand so freundlich seinen könnte und ein posten könnte
Mfg ReDoX

zusammenfalten · markieren

Delphi-Quellcode:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormResize(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormPaint(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ImagePos:TPoint;
  end;

var
  Form1: TForm1;
  MouseStartPos : TPoint;
  Down : Boolean = False;
  OffScreen, Picture : TBitmap;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
//Image1.Picture.Bitmap.LoadFromFile('c:\Pic.bmp');
ImagePos := Point(0,0);

Picture := TBitmap.Create;
Picture.LoadFromFile('c:\Pic.bmp');


OffScreen := TBitmap.Create;
OffScreen.PixelFormat := pf32bit;
OffScreen.Width := Width;
OffScreen.Height := Height;
OffScreen.Canvas.Brush.Color := clBlue;
OffScreen.Canvas.FillRect(Rect(0,0,OffScreen.Width,OffScreen.Height));
OffScreen.Canvas.Draw(0,0,Picture);
Canvas.Draw(0,0,OffScreen);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 MouseStartPos := Point(x,y);
 Down := True;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
  var temp : tpoint;
begin
 if Down then
 begin
   temp := Point( MouseStartPos.X - ImagePos.X ,MouseStartPos.Y - ImagePos.Y);
   OffScreen.Canvas.FillRect(Rect(0,0,OffScreen.Width,OffScreen.Height));
   OffScreen.Canvas.Draw(temp.x,temp.y,Picture);
   Canvas.Draw(0,0,OffScreen);
   MouseStartPos := Point(x,y)
 end;
end;

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

procedure TForm1.FormResize(Sender: TObject);
begin
OffScreen.Width := Width;
OffScreen.Height := Height;
//Image1.Picture.Bitmap.Width := Image1.Width;
//Image1.Picture.Bitmap.Height :=Image1.Height;
FormPaint(self);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
OffScreen.Free;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
   Canvas.Draw(0,0,OffScreen);
end;

Allerdings ohne TImage Komponente zu benutzen...

Kurz vor dem zehnjährigen Jubiläum dieses Themas hat mir der Code von Haris noch einmal sehr geholfen. Mein Problem war etwas anders gelagert:

In einem TImage mit einer Breite von ca. 1.700 Pixeln wird ein JPG mit ca. 4.900 Pixeln Kantenlänge proportional verkleinert angezeigt. Ich möchte nun, dass (wie z.B. bei Faststone) beim Klicken auf eine Stelle im TImage das JPG in nativer Auflösung (1:1) angezeigt wird, und dass genau die angeklickte Stelle unter dem Mauszeiger eingestellt wird. Außerdem soll sich das native JPG beim Bewegen mit gedrückter Maustaste mit bewegen, und zwar proportional; das heißt, dass beim Durchfahren der 1.700 Pixel des TImages mit der Maus die ganzen 4.900 Pixel des nativen JPG durchfahren (also angezeigt) werden. Analog das Ganze natürlich auch vertikal.

Der folgende Code leistet genau das. Aus gegebenem Anlass weise ich darauf hin, dass es sich hier nur um ein Gerüst und nicht um fertigen Code handelt. Die Freigabe der Ressourcen muss natürlich beim Schließen der Form erfolgen.

Anmerkungen:
Das Schnellste, was ich bisher zum Dekodieren von JPEG gefunden habe, ist "jpegdec", das jetzt von Arnaud Bouchez gepflegt wird; die Anpassung für Delphi findet sich beispielsweise hier.
Für JPG, die kleiner sind als das TImage, müsste der Code noch angepasst werden.

zusammenfalten · markieren

Delphi-Quellcode:

type
Image1 : TImage;

var
  MausStartPos : TPoint;
  AktBmp : TBitmap;
  TempBmp : TBitmap;
  BildFaktorH : Single;
  BildFaktorV : Single;
  MS : TMemoryStream;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TempBmp := TBitmap.Create;
  TempBmp.PixelFormat := pf32bit;
  AktBmp := TBitmap.Create;
  AktBmp.PixelFormat := pf32bit;
  MS := TMemoryStream.Create;
end;

function TForm1.LadeBildInBMP(Datname:string):Boolean;
begin
  Try
    MS.LoadFromFile(Datname);
    AktBmp := JpegDecode(MS.Memory,MS.Size);
  Except
    FreeAndNil(AktBmp);
  End;
  Result := (AktBmp <> nil);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  If ssLeft in Shift then begin
    TempBmp.Width := AktBmp.Width;
    TempBmp.Height := AktBmp.Height;
    TempBmp.Canvas.Brush.Color := clBlack;
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(0,0,TempBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
    BildFaktorH := -(TempBmp.Width - Image1.Width) / Image1.Width;
    BildFaktorV := -(TempBmp.Height - Image1.Height) / Image1.Height;
    MausStartPos := Point(Round(x * BildFaktorH),Round(y * BildFaktorV));
    // Anzeigen
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(MausStartPos.X,MausStartPos.Y,AktBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  If ssLeft in Shift then begin
    TempBmp.Canvas.Brush.Color := clBlue;
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(MausStartPos.X,MausStartPos.Y,AktBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
    MausStartPos := Point(Round(x * BildFaktorH),Round(y * BildFaktorV));
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Image1.Picture.Bitmap := AktBmp;
  TempBmp.Width := 0;
end;

Zitat von Benmik:

Kurz vor dem zehnjährigen Jubiläum dieses Themas hat mir der Code von Haris noch einmal sehr geholfen. Mein Problem war etwas anders gelagert:

In einem TImage mit einer Breite von ca. 1.700 Pixeln wird ein JPG mit ca. 4.900 Pixeln Kantenlänge proportional verkleinert angezeigt. Ich möchte nun, dass (wie z.B. bei Faststone) beim Klicken auf eine Stelle im TImage das JPG in nativer Auflösung (1:1) angezeigt wird, und dass genau die angeklickte Stelle unter dem Mauszeiger eingestellt wird. Außerdem soll sich das native JPG beim Bewegen mit gedrückter Maustaste mit bewegen, und zwar proportional; das heißt, dass beim Durchfahren der 1.700 Pixel des TImages mit der Maus die ganzen 4.900 Pixel des nativen JPG durchfahren (also angezeigt) werden. Analog das Ganze natürlich auch vertikal.

Der folgende Code leistet genau das. Aus gegebenem Anlass weise ich darauf hin, dass es sich hier nur um ein Gerüst und nicht um fertigen Code handelt. Die Freigabe der Ressourcen muss natürlich beim Schließen der Form erfolgen.

Anmerkungen:
Das Schnellste, was ich bisher zum Dekodieren von JPEG gefunden habe, ist "jpegdec", das jetzt von Arnaud Bouchez gepflegt wird; die Anpassung für Delphi findet sich beispielsweise hier.
Für JPG, die kleiner sind als das TImage, müsste der Code noch angepasst werden.

zusammenfalten · markieren

Delphi-Quellcode:

type
Image1 : TImage;

var
  MausStartPos : TPoint;
  AktBmp : TBitmap;
  TempBmp : TBitmap;
  BildFaktorH : Single;
  BildFaktorV : Single;
  MS : TMemoryStream;

procedure TForm1.FormCreate(Sender: TObject);
begin
  TempBmp := TBitmap.Create;
  TempBmp.PixelFormat := pf32bit;
  AktBmp := TBitmap.Create;
  AktBmp.PixelFormat := pf32bit;
  MS := TMemoryStream.Create;
end;

function TForm1.LadeBildInBMP(Datname:string):Boolean;
begin
  Try
    MS.LoadFromFile(Datname);
    AktBmp := JpegDecode(MS.Memory,MS.Size);
  Except
    FreeAndNil(AktBmp);
  End;
  Result := (AktBmp <> nil);
end;

procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  If ssLeft in Shift then begin
    TempBmp.Width := AktBmp.Width;
    TempBmp.Height := AktBmp.Height;
    TempBmp.Canvas.Brush.Color := clBlack;
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(0,0,TempBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
    BildFaktorH := -(TempBmp.Width - Image1.Width) / Image1.Width;
    BildFaktorV := -(TempBmp.Height - Image1.Height) / Image1.Height;
    MausStartPos := Point(Round(x * BildFaktorH),Round(y * BildFaktorV));
    // Anzeigen
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(MausStartPos.X,MausStartPos.Y,AktBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
  end;
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  If ssLeft in Shift then begin
    TempBmp.Canvas.Brush.Color := clBlue;
    TempBmp.Canvas.FillRect(Rect(0,0,TempBmp.Width,TempBmp.Height));
    TempBmp.Canvas.Draw(MausStartPos.X,MausStartPos.Y,AktBmp);
    Form1.Canvas.Draw(0,0,TempBmp);
    MausStartPos := Point(Round(x * BildFaktorH),Round(y * BildFaktorV));
  end;
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Image1.Picture.Bitmap := AktBmp;
  TempBmp.Width := 0;
end;

Absolut!
Sehr gutes Beispiel!

Vielen Dank, Martin.

Ich bin mittlerweile von jpegdec zu libjpeg-turbo gewechselt, mit den Headern von hier. Leider, leider muss man dazu DLLs mitgeben (für 32 und 64 Bit und die borlndmm.dll), aber libjpeg-turbo ist äußerst schnell und jpegdec dekodiert leider manche JPG nicht.

Am einfachsten benutzt man den Wrapper von hier, kopiert also cgJpeg.pas und libJPEG.pas in den Pfad und nimmt cgJpeg in die uses-Klausel auf.
Dann ist alles sehr einfach:

zusammenfalten · markieren

Delphi-Quellcode:

uses cgJpeg

var Bmp:TJPEGImage;

function TForm1.LadeBildInBMP(Datname:string):Boolean;
begin
  Try
    AktBmp.LoadFromFile(Datname);
  Except
    ShowMessage(SysErrorMessage(GetLastError));
  End;
  Result := (AktBmp <> nil);
end;

Auch dies ist natürlich nur ein Code-Gerüst zum Selberbauen.