![]() |
Genaue Position des Mausklicks in einem Canvas
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) |
AW: Genaue Position des Mausklicks in einem Canvas
|
AW: Genaue Position des Mausklicks in einem Canvas
Wo hast du denn die absolute Position her?
OnMouseDown/OnMouseUp liefen zumindestens die relative Klickposition. |
AW: Genaue Position des Mausklicks in einem Canvas
Liste der Anhänge anzeigen (Anzahl: 1)
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. |
AW: Genaue Position des Mausklicks in einem Canvas
Was müssen meine trüben Augen da sehen?? :shock:
GLOBALE VARIABLEN
Delphi-Quellcode:
Nicht dass globale Variablen generell verboten wären, aber wenn schon sollten globale Variablen einen langen Bezeichner bekommen.
var
FormPersonPictureEdit: TFormPersonPictureEdit; MouseDownFlag: Boolean = False; MX, MY, C: Integer; PathPicture: String = ''; implementation 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. |
AW: Genaue Position des Mausklicks in einem Canvas
Zitat:
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. ;-) |
AW: Genaue Position des Mausklicks in einem Canvas
Da die VCL aber selber globale Variablen benutzt - erzeugt -, wäre das so nicht umsetzbar ;)
|
AW: Genaue Position des Mausklicks in einem Canvas
Die vielen Codezeilen verwirren mich.
Wenn sich ein Bild MyImage in meiner MyPaintBox befindet, und das Bild ist mit dem Zoomfactor vergrößert, dann ergibt sich doch die absolute Koordinate einer MousePos (relativ zu MyPaintBox) wie folgt:
Delphi-Quellcode:
Die Operatoren [+] und [-] auf TPoint sind bekannt, müssten aber auskodiert werden.
ZoomedMousePos := ScaledPoint(MousePos, Zoomfactor) - MyImage.TopLeft; // in 'gezoomte' absolute Koordinaten umrechnen
PointOnOriginalImage := ScaledPoint (ZoomedMousePos, 1/Zoomfactor); // Absoluter Punkt im gezoomten Bild => ungezoomt. Die Funktion 'ScaledPoint' multipliziert die Koordinaten des Punktes mit dem Zoomfactor. Und bei dem freundlicherweise geposteted Stück Code fällt mir als erstes auf, das die Refactoring-Funktion unbekannt zu sein scheint. |
AW: Genaue Position des Mausklicks in einem Canvas
Danke an alle für die Antworten - Ich bin Himitsus Hinweis gefolgt und verwende jetzt statt des Events onclick den Event onmousedown, das geht mindestens genausogut und liefert mir direkt die Relativkoordinaten des Clicks - der Zoomfaktor wird in den dahinterliegenden Routinen bei mir automatisch berücksichtigt, darum brauch ich mich an der Stelle nicht zu kümmern.
|
AW: Genaue Position des Mausklicks in einem Canvas
Oha! Ihr habt ja im Grunde Recht - ABER:
In meinem Projekt achte ich schon auf Ordnung und auch Trennung von Daten und GUI (und nutze inzwischen auch englische Bezeichner). Das o.g. Formular fällt da aus der Reihe und liefert einen Bildausschnitt in das "richtige Projekt" zurück. Das habe ich aus einem früheren Projekt übernommen und nicht angepasst, da es problemlos und korrekt funktioniert. Soweit zu meiner Verteidigung ;-) (Ich hatte es ja nur gut gemeint). PS: Musste den Beitrag gerade nochmal schreiben, da die DP meinen ersten Beitrag mit einem Fehler abgelehnt hatte ;-( |
AW: Genaue Position des Mausklicks in einem Canvas
[OT]
Zitat:
[/OT] |
Alle Zeitangaben in WEZ +1. Es ist jetzt 21:08 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz