Genaue Position des Mausklicks in einem Canvas

[idefix2]

Hallo,

ich habe auf meiner Form ein TImage, und muss die absoluten Mauskoordinaten bei einem Mausclick in die Relative Position am Canvas des TImage pixelgenau umrechnen.
Gibt es da ein fertige Funktionen, die mir sagt, wo auf meinem Canvas eine in Screen-Koordinaten angegebener Punkt liegt, oder muss ich das zu Fuss ausrechnen (unter Berücksichtigung der Breite des Formularrands und anderer Unwägbarkeiten)

[Namenloser]

Gibt es: ScreenToClient und ClientToScreen.

[himitsu]

Wo hast du denn die absolute Position her?

OnMouseDown/OnMouseUp liefen zumindestens die relative Klickposition.

[stahli]

Ich habe das von Hand gemacht, da der sichtbare Canvas durch den mögliche Zoom ja nicht das originale Bild darstellt.
Der User kann damit einen Bildausschnitt auswählen.
Anbei mal der Quelltext, falls Du daraus etwas entnehmen willst...

Delphi-Quellcode:

unit fPersonPictureEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, DBCtrls, ExtCtrls, ExtDlgs, jpeg,
  sPanel, sGroupBox, odPanel, odPanelCustomPerson, odPanelMember, ComCtrls, sComboBoxes, acShellCtrls, sListView, sTreeView;

type
  TFormPersonPictureEdit = class(TForm)
    PanelMain: TPanel;
    sPanel2: TPanel;
    ImageMain: TImage;
    PLO: TImage;
    PRO: TImage;
    PLU: TImage;
    PRU: TImage;
    PO: TImage;
    PR: TImage;
    PU: TImage;
    PL: TImage;
    Shape: TShape;
    BitBtnSpielerBildDateiOeffnen: TBitBtn;
    ButtonShapePositionieren: TButton;
    ButtonBildUebernehmen: TButton;
    ImageTmp: TImage;
    sGroupBoxBitmap: TGroupBox;
    sGroupBoxNewBitmap: TGroupBox;
    sPanel1: TPanel;
    ImageResult: TImage;
    Panel1: TPanel;
    ImageOld: TImage;
    Panel2: TPanel;
    BitBtn2: TBitBtn;
    BitBtn1: TBitBtn;
    Panel3: TPanel;
    Panel4: TPanel;
    sShellComboBox: TsShellComboBox;
    sShellTreeView: TsShellTreeView;
    Panel5: TPanel;
    sShellListView: TsShellListView;
    procedure AutoSelect;
    procedure BitBtnSpielerBildDateiOeffnenClick(Sender: TObject);
    procedure ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ShapeContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
    procedure BitBtnSpielerBildLoeschenClick(Sender: TObject);
    procedure ButtonBildUebernehmenClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure PMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure PMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure PMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ButtonShapePositionierenClick(Sender: TObject);
    procedure ImageMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ImageMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure OpenPictureFile(PictureFileName: String); virtual;
    procedure sShellListViewClick(Sender: TObject);
    procedure sShellListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
  private
    { Private-Deklarationen }
  public
    AutoSelectFlag: Boolean;
  end;

  TCanvasShape = class(TShape)
  private
    { private-Deklarationen }
  protected
    { protected-Deklarationen }
  public
    { public-Deklarationen }
    function CopyCanvas: TCanvas;
  published
    { published-Deklarationen }
  end;

var
  FormPersonPictureEdit: TFormPersonPictureEdit;
  MouseDownFlag: Boolean = False;
  MX, MY, C: Integer;
  PathPicture: String = '';

implementation

uses
  Math, ssGraphics, ssFiles, ShlObj, iStahliSport;

const
  PS = 12;
  PSH = PS div 2;

{$R *.dfm}

procedure TFormPersonPictureEdit.AutoSelect;
var
  F: Real;
begin
  AutoSelectFlag := False;
  if ImageMain.Picture.Bitmap.Width > ImageMain.Picture.Bitmap.Height then
    begin
      F := ImageMain.Picture.Bitmap.Height / ImageMain.Picture.Bitmap.Width;
      Shape.Width := Round(PanelMain.Width * F);
      Shape.Height := Round(PanelMain.Height * F);
    end
  else if ImageMain.Picture.Bitmap.Width < ImageMain.Picture.Bitmap.Height then
    begin
      F := ImageMain.Picture.Bitmap.Width / ImageMain.Picture.Bitmap.Height;
      Shape.Width := Round(PanelMain.Width * F);
      Shape.Height := Round(PanelMain.Height * F);
    end
  else
    begin
      Shape.Width := PanelMain.Width;
      Shape.Height := PanelMain.Height;
    end;
  Shape.Left := 0;
  Shape.Top := 0;
  ButtonShapePositionierenClick(Self);
end;

procedure TFormPersonPictureEdit.BitBtnSpielerBildDateiOeffnenClick(Sender: TObject);
begin
  // if PathPicture = '' then
  // PathPicture := GetSpecialFolder(0, CSIDL_MYPICTURES);
  // OpenPictureDialog.InitialDir := PathPicture;
  // OpenPictureDialog.FileName := '*.bmp; *.jpg';
  // if OpenPictureDialog.Execute then
  // begin
  // PathPicture := ExtractFilePath(OpenPictureDialog.FileName);
  // OpenPictureFile(OpenPictureDialog.FileName);
  // end;
  // ButtonBildUebernehmenClick(Self);
  // AutoSelect;
end;

procedure TFormPersonPictureEdit.BitBtnSpielerBildLoeschenClick(Sender: TObject);
begin
  ImageResult.Picture.Bitmap.FreeImage;
end;

procedure TFormPersonPictureEdit.ButtonBildUebernehmenClick(Sender: TObject);
var
  L, T, W, H: Integer;
  DR, SR: TRect;
  HF, VF, F: Real;
begin
  HF := ImageMain.Width / Max(ImageMain.Picture.Bitmap.Width, 1);
  VF := ImageMain.Height / Max(ImageMain.Picture.Bitmap.Height, 1);
  if HF < VF then
    F := HF
  else
    F := VF;

  L := Round(Shape.Left / F);
  T := Round(Shape.Top / F);
  W := Round(Shape.Width / F);
  H := Round(Shape.Height / F);
  if W < H then
    W := H;
  if H < W then
    H := W;

  ImageTmp.Width := W;
  ImageTmp.Height := H;
  ImageTmp.Picture.Bitmap.Width := W;
  ImageTmp.Picture.Bitmap.Height := H;
  DR.Left := 0;
  DR.Top := 0;
  DR.Right := W;
  DR.Bottom := H;
  SR.Left := L;
  SR.Top := T;
  SR.Right := L + W;
  SR.Bottom := T + H;

  ImageTmp.Picture.Bitmap.Canvas.FillRect(ImageTmp.ClientRect);

  ImageTmp.Picture.Bitmap.Canvas.CopyRect(DR, ImageMain.Picture.Bitmap.Canvas, SR);

  W := 150;
  H := 150;
  DR.Left := 0;
  DR.Top := 0;
  DR.Right := W;
  DR.Bottom := H;

  ImageResult.Picture.Bitmap.Width := W;
  ImageResult.Picture.Bitmap.Height := H;
  ImageResult.Picture.Bitmap.Canvas.StretchDraw(DR, ImageTmp.Picture.Bitmap);
end;

procedure TFormPersonPictureEdit.ButtonShapePositionierenClick(Sender: TObject);
var
  P: TPoint;
  DS, DI: Integer;
begin
  if (Shape.Width > PanelMain.ClientWidth) then
    begin
      Shape.Left := 0;
      Shape.Width := PanelMain.ClientWidth;
    end;
  if (Shape.Height > PanelMain.ClientHeight) then
    begin
      Shape.Top := 0;
      Shape.Height := PanelMain.ClientHeight;
    end;
  DS := ((Shape.Left + Shape.Width) - PanelMain.ClientWidth);
  if (DS > 0) then
    begin
      Shape.Left := (Shape.Left - DS);
      DI := (ImageMain.Width - PanelMain.ClientWidth + ImageMain.Left);
      if (DI > 0) then
        begin
          ImageMain.Left := (ImageMain.Left - Min(DI, DS));
          P.X := MX;
          P.Y := MY;
          P := Shape.ClientToScreen(P);
          SetCursorPos(P.X, P.Y);
        end;
    end;
  DS := ((Shape.Top + Shape.Height) - PanelMain.ClientHeight);
  if (DS > 0) then
    begin
      Shape.Top := (Shape.Top - DS);
      DI := (ImageMain.Height - PanelMain.ClientHeight + ImageMain.Top);
      if (DI > 0) then
        begin
          ImageMain.Top := (ImageMain.Top - Min(DI, DS));
          P.X := MX;
          P.Y := MY;
          P := Shape.ClientToScreen(P);
          SetCursorPos(P.X, P.Y);
        end;
    end;
  DS := (-Shape.Left);
  if (DS > 0) then
    begin
      Shape.Left := (Shape.Left + DS);
      DI := (-ImageMain.Left);
      if (DI > 0) then
        begin
          ImageMain.Left := (ImageMain.Left + Min(DI, DS));
          P.X := MX;
          P.Y := MY;
          P := Shape.ClientToScreen(P);
          SetCursorPos(P.X, P.Y);
        end;
    end;
  DS := (-Shape.Top);
  if (DS > 0) then
    begin
      Shape.Top := (Shape.Top + DS);
      DI := (-ImageMain.Top);
      if (DI > 0) then
        begin
          ImageMain.Top := (ImageMain.Top + Min(DI, DS));
          P.X := MX;
          P.Y := MY;
          P := Shape.ClientToScreen(P);
          SetCursorPos(P.X, P.Y);
        end;
    end;
  Shape.Refresh;
  PLO.Left := (Shape.Left - PSH);
  PLO.Top := (Shape.Top - PSH);
  PRU.Left := (Shape.Left + Shape.Width - PSH);
  PRU.Top := (Shape.Top + Shape.Height - PSH);
  PLU.Left := (Shape.Left - PSH);
  PLU.Top := (Shape.Top + Shape.Height - PSH);
  PRO.Left := (Shape.Left + Shape.Width - PSH);
  PRO.Top := (Shape.Top - PSH);
  PL.Left := (Shape.Left - PSH);
  PL.Top := (Shape.Top + (Shape.Height div 2) - PSH);
  PR.Left := (Shape.Left + Shape.Width - PSH);
  PR.Top := (Shape.Top + (Shape.Height div 2) - PSH);
  PU.Left := (Shape.Left + (Shape.Width div 2) - PSH);
  PU.Top := (Shape.Top + Shape.Height - PSH);
  PO.Left := (Shape.Left + (Shape.Width div 2) - PSH);
  PO.Top := (Shape.Top - PSH);
  ImageMain.Refresh;
  ButtonBildUebernehmenClick(Self);
end;

procedure TFormPersonPictureEdit.FormActivate(Sender: TObject);
begin
  // StopClosingForm(Self);
  if ((ImageMain.Picture.Graphic = nil) or (ImageMain.Picture.Graphic.Empty)) then
    BitBtnSpielerBildDateiOeffnenClick(Self);
  if AutoSelectFlag then
    AutoSelect;
  if PathPicture = '' then
    PathPicture := GetSpecialFolder(0, CSIDL_MYPICTURES);
  if sShellTreeView.Tag = 0 then
    begin
      sShellTreeView.Path := PathPicture;
      sShellTreeView.Tag := 1;
    end;
end;

procedure TFormPersonPictureEdit.FormCreate(Sender: TObject);
begin
  sShellComboBox.Align := alClient;
  PanelMain.DoubleBuffered := True;
  Shape.Left := ((PanelMain.Width div 2) - (Shape.Width div 2));
  Shape.Top := ((PanelMain.Height div 2) - (Shape.Height div 2));
  ButtonShapePositionierenClick(Self);
  Refresh;
  ButtonBildUebernehmenClick(Self);
  // OpenPictureDialog.OnShow := FormTurniere.OpenDialogShow;
  // OpenPictureDialog.OnClose := FormTurniere.OpenDialogClose;
  PLO.Width := PS;
  PLO.Height := PS;
  PLO.BringToFront;
  PRU.Width := PS;
  PRU.Height := PS;
  PRU.BringToFront;
  PLU.Width := PS;
  PLU.Height := PS;
  PLU.BringToFront;
  PRO.Width := PS;
  PRO.Height := PS;
  PRO.BringToFront;
  PL.Width := PS;
  PL.Height := PS;
  PL.BringToFront;
  PR.Width := PS;
  PR.Height := PS;
  PR.BringToFront;
  PU.Width := PS;
  PU.Height := PS;
  PU.BringToFront;
  PO.Width := PS;
  PO.Height := PS;
  PO.BringToFront;
end;

procedure TFormPersonPictureEdit.ImageMainMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  ImageMain.Cursor := crHandPoint;
  MouseDownFlag := True;
  Shape.Pen.Color := clBlue;
  P.X := X;
  P.Y := Y;
  P := ImageMain.ClientToScreen(P);
  P := PanelMain.ScreenToClient(P);
  MX := P.X;
  MY := P.Y;
  Shape.Left := (MX - (Shape.Width div 2));
  Shape.Top := (MY - (Shape.Height div 2));
  MX := (Shape.Width div 2);
  MY := (Shape.Height div 2);
  ButtonShapePositionierenClick(Self);
end;

procedure TFormPersonPictureEdit.ImageMainMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if (MouseDownFlag) then
    begin
      P.X := X;
      P.Y := Y;
      P := ImageMain.ClientToScreen(P);
      P := PanelMain.ScreenToClient(P);
      Shape.Left := (P.X - MX);
      Shape.Top := (P.Y - MY);
      ButtonShapePositionierenClick(Self);
    end;
end;

procedure TFormPersonPictureEdit.ImageMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseDownFlag := False;
  ButtonBildUebernehmenClick(Self);
  Shape.Pen.Color := clBlack;
  ImageMain.Cursor := crCross;
end;

procedure TFormPersonPictureEdit.OpenPictureFile(PictureFileName: String);
var
  Jpg: TJPEGImage;
begin
  if IsJPEG(PictureFileName) then
    begin
      Jpg := TJPEGImage.Create;
      try
        Jpg.LoadFromFile(PictureFileName);
        ImageMain.Picture.Bitmap.Assign(Jpg);
      finally
        FreeAndNil(Jpg);
      end;
    end
  else
    begin
      ImageMain.Picture.LoadFromFile(PictureFileName);
    end;
  ImageMain.Transparent := ImageMain.Picture.Bitmap.Empty;
  ButtonBildUebernehmenClick(Self);
end;

procedure TFormPersonPictureEdit.PMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseDownFlag := True;
  Shape.Pen.Color := clBlue;
  MX := 0;
  MY := 0;
end;

procedure TFormPersonPictureEdit.PMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
  MP: TImage;
  PX, PY, LX, LY, L, ZX, ZY: Integer;
begin
  if (MouseDownFlag) then
    begin
      MP := TImage(Sender);
      P.X := X;
      P.Y := Y;
      P := MP.ClientToScreen(P);
      P := PanelMain.ScreenToClient(P);
      PX := P.X;
      PY := P.Y;
      if (MP.Name = 'PRU') then
        begin
          LX := Max((PX - Shape.Left), 16);
          LY := Max((PY - Shape.Top), 16);
          L := Max(LX, LY);
          Shape.Width := L;
          Shape.Height := L;
        end;
      if (MP.Name = 'PRO') then
        begin
          LX := Max((PX - Shape.Left), 16);
          LY := Max(((Shape.Top + Shape.Height) - PY), 16);
          L := Max(LX, LY);
          Shape.Top := (Shape.Top + Shape.Height - L);
          Shape.Width := L;
          Shape.Height := L;
        end;
      if (MP.Name = 'PLO') then
        begin
          LX := Max(((Shape.Left + Shape.Width) - PX), 16);
          LY := Max(((Shape.Top + Shape.Height) - PY), 16);
          L := Max(LX, LY);
          Shape.Top := (Shape.Top + Shape.Height - L);
          Shape.Left := (Shape.Left + Shape.Width - L);
          Shape.Width := L;
          Shape.Height := L;
        end;
      if (MP.Name = 'PLU') then
        begin
          LX := Max(((Shape.Left + Shape.Width) - PX), 16);
          LY := Max((PY - Shape.Top), 16);
          L := Max(LX, LY);
          Shape.Left := (Shape.Left + Shape.Width - L);
          Shape.Width := L;
          Shape.Height := L;
        end;
      if (MP.Name = 'PR') then
        begin
          ZX := (Shape.Left + (Shape.Width div 2));
          ZY := (Shape.Top + (Shape.Height div 2));
          LX := Max((PX - ZX), 16);
          // LY:=Max((PY-ZY),16);
          L := LX;
          Shape.Width := (L * 2);
          Shape.Height := (L * 2);
          Shape.Left := (ZX - L);
          Shape.Top := (ZY - L);
        end;
      if (MP.Name = 'PO') then
        begin
          ZX := (Shape.Left + (Shape.Width div 2));
          ZY := (Shape.Top + (Shape.Height div 2));
          // LX:=Max((ZX-PX),16);
          LY := Max((ZY - PY), 16);
          L := LY;
          Shape.Width := (L * 2);
          Shape.Height := (L * 2);
          Shape.Left := (ZX - L);
          Shape.Top := (ZY - L);
        end;
      if (MP.Name = 'PL') then
        begin
          ZX := (Shape.Left + (Shape.Width div 2));
          ZY := (Shape.Top + (Shape.Height div 2));
          LX := Max((ZX - PX), 16);
          // LY:=Max((ZY-PY),16);
          L := LX;
          Shape.Width := (L * 2);
          Shape.Height := (L * 2);
          Shape.Left := (ZX - L);
          Shape.Top := (ZY - L);
        end;
      if (MP.Name = 'PU') then
        begin
          ZX := (Shape.Left + (Shape.Width div 2));
          ZY := (Shape.Top + (Shape.Height div 2));
          // LX:=Max((PX-ZX),16);
          LY := Max((PY - ZY), 16);
          L := LY;
          Shape.Width := (L * 2);
          Shape.Height := (L * 2);
          Shape.Left := (ZX - L);
          Shape.Top := (ZY - L);
        end;
      ButtonShapePositionierenClick(Self);
    end;
end;

procedure TFormPersonPictureEdit.PMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseDownFlag := False;
  ButtonBildUebernehmenClick(Self);
  Shape.Pen.Color := clBlack;
end;

procedure TFormPersonPictureEdit.ShapeContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean);
begin
  ButtonBildUebernehmenClick(Self);
end;

procedure TFormPersonPictureEdit.ShapeMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseDownFlag := True;
  Shape.Pen.Color := clBlue;
  MX := X;
  MY := Y;
end;

procedure TFormPersonPictureEdit.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
var
  P: TPoint;
begin
  if (MouseDownFlag) then
    begin
      P.X := X;
      P.Y := Y;
      P := Shape.ClientToScreen(P);
      P := PanelMain.ScreenToClient(P);
      Shape.Left := (P.X - MX);
      Shape.Top := (P.Y - MY);
      ButtonShapePositionierenClick(Self);
    end;
end;

procedure TFormPersonPictureEdit.ShapeMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  MouseDownFlag := False;
  ButtonBildUebernehmenClick(Self);
  Shape.Pen.Color := clBlack;
end;

procedure TFormPersonPictureEdit.sShellListViewChange(Sender: TObject; Item: TListItem; Change: TItemChange);
begin
  if sShellListView.Selected <> nil then
    begin
      if sShellListView.SelectedFolder.IsFile then
        begin
          PathPicture := ExtractFilePath(sShellListView.SelectedFolder.PathName);
          OpenPictureFile(sShellListView.SelectedFolder.PathName);
          ButtonBildUebernehmenClick(Self);
          AutoSelect;
        end;
    end;
end;

procedure TFormPersonPictureEdit.sShellListViewClick(Sender: TObject);
begin
end;

{ TCanvasShape }

function TCanvasShape.CopyCanvas: TCanvas;
begin
  Result := Canvas;
end;

end.

[sx2008]

Was müssen meine trüben Augen da sehen??
GLOBALE VARIABLEN

Delphi-Quellcode:

var
  FormPersonPictureEdit: TFormPersonPictureEdit;
  MouseDownFlag: Boolean = False;
  MX, MY, C: Integer;
  PathPicture: String = '';
implementation

Nicht dass globale Variablen generell verboten wären, aber wenn schon sollten globale Variablen einen langen Bezeichner bekommen.
Die Variablen MouseDownFlag, MX, MY, C und PicturePath gehören allerdings in die Klasse TFormPersonPictureEdit.

Und keine einzige Kommentarzeile im gesamten Code?
Nein, die auskommentierten Codezeilen zählen nicht als Kommentar sondern verwirren nur zusätzlich.

[jaenicke]

Zitat von sx2008:

Und keine einzige Kommentarzeile im gesamten Code?

Ich schreibe auch relativ wenige Kommentare. Allerdings benutze ich sprechende Bezeichner, so dass man dennoch sieht was passiert. Bei Variablen wie PX, PY, LX, LY, L, ZX oder ZY dürfte die selbsterklärende Wirkung allerdings ausbleiben.
Immerhin haben die Komponenten Namen.

Schön wäre es, wenn man die Verwendung von globalen Variablen extra aktivieren müsste wie die nicht konstanten Konstanten... Dann würde man beim Lernen von Delphi gar nicht auf die Idee kommen und später, wenn man sich gut auskennt, benutzt man die ja eh normalerweise nicht mehr. Insbesondere, wenn man ohne sie gelernt hat.

Aber zum Thema:
Ich würde das ganze kapseln, so dass du zur Umrechnung einfach eine Funktion aufrufen kannst. Analog zu ClientToScreen usw.
Dann musst du dich an anderer Stelle nicht mehr darum kümmern wie das dahinter funktioniert.