Genaue Position des Mausklicks in einem Canvas

[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.