Image 坐标转换问题

Question

  我的Image空间大小事501*346大小的,载入2560*1920大小的图片;然后要在Image上面画线,但是画的线和鼠标的点不在一个点上,在图片的任意位置画点,Image上总是在左上角画,下面是代码,麻烦各位大侠帮忙看下
var
  Form1: TForm1;
  Drawing: Boolean;
  Origin, MovePt: TPoint;
  Bitmap: TBitmap;
......
procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True;
  Image.Canvas.MoveTo(X,Y);
  Origin := Point(X,Y);
  MovePt := Origin;
end;procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X, Y);
    DrawShape(Origin, MovePt, pmNotXor);
  end;
end;procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, Point(X,Y), pmCopy);
    Drawing := False;
  end;
end;procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
    Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
  end;
end;

Answer 1

你图片做了拉伸, 最后画上去的不是你鼠标落下的那个点
把STRTCH 属性去掉 

Answer 2

但是我要在Image里面显示整个图片,然后在上面画线!

Answer 3

你是要画到原图的相应位置上吗？如果是那可以这样
两个坐标换算一下，当然你的图片不能有变形，就是image 尺寸和原图尺寸成比例，然后再换算就可以了
比如 ：
image : w = 10 ; h = 20;
原图   : w = 20;  h = 40;
那如果在image上的坐标是 (5,10) 那在原图位置上对应的就是(10,20)

Answer 4

mdejtod我是初学的 能写详细点吗?谢谢!!

Answer 5

图像不是直接放在image里面，而是在image.picture.bitmap里面，
screth后，image坐标和存放图像的bitmap坐标不一致了在相应的地方做如下的坐标转换 Origin := Point(X * image1.Picture.Bitmap.Width div Image1.Width,
    Y * image1.Picture.Bitmap.Height div Image1.Height); MovePt := Point(X * image1.Picture.Bitmap.Width div Image1.Width,
    Y * image1.Picture.Bitmap.Height div Image1.Height); //...........

Answer 6

谢谢milertom!!效果实现了 ,但是画出来的线是虚线,请问要怎么才能画出实线呀?

Answer 7

用窗口的DC去画就可以了坐标都改成 Origin := Point(Image1.Left + x, Image1.Top + y);
画的时候把
Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y); 改成
Canvas.MoveTo(TopLeft.X, TopLeft.Y); 

Answer 8

我把Pen.Style设置成 psSolid;但是画出来的线是虚线,请问要怎么才能画出实线呀?

Answer 9

sanguomi这是我所有的代码!麻烦帮忙看下谢谢!图片比Image控件大!unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, Grids, DBGrids, StdCtrls, ExtCtrls, ExtDlgs, Buttons,jpeg,
  DBCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Splitter1: TSplitter;
    Panel2: TPanel;
    Panel3: TPanel;
    Splitter2: TSplitter;
    Image: TImage;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    qGraphData: TADODataSet;
    OpenPD: TOpenPictureDialog;
    DBNavigator1: TDBNavigator;
    Panel5: TPanel;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    Panel4: TPanel;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure BitBtn3Click(Sender: TObject);
    procedure qGraphDataAfterScroll(DataSet: TDataSet);
    procedure ImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
  end;var
  Form1: TForm1;
  Drawing: Boolean;
  Origin, MovePt: TPoint;
  Bitmap: TBitmap;
implementation{$R *.dfm}procedure TForm1.BitBtn3Click(Sender: TObject);
var
  GraphName: String;
begin
  if OpenPD.Execute then
  begin
    GraphName := ExtractFileName(OpenPD.FileName);
    qGraphData.AfterScroll := nil;
    qGraphData.Append;
    qGraphData.FieldByName('jpgName').asstring := GraphName;
    TBlobField(qGraphData.FieldByName('jpgValue')).loadfromfile(OpenPD.FileName);
    qGraphData.post;
    qGraphData.AfterScroll := qGraphDataAfterScroll;
  end;end;procedure TForm1.qGraphDataAfterScroll(DataSet: TDataSet);
var
  MS: TMemoryStream;
  sjpg: TJpegImage;
begin
  if qGraphData.Active and (not qGraphData.IsEmpty ) then
  begin
    MS := TMemoryStream.Create;
    sjpg := TJpegImage.Create;
    try
      TBlobField(qGraphData.FieldByName('jpgValue')).SaveToStream(MS);
      ms.position := 0;
      sjpg.LoadFromStream(ms);
      Image.Picture.Bitmap.Assign(sjpg);
    finally
      sjpg.Free;
      MS.Free;
    end;
  end;
  ListBox1.Items.Text := qGraphData.Fieldbyname('jpgInfo').AsString;
end;procedure TForm1.ImageMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  Drawing := True;
  Origin := Point(X * image.Picture.Bitmap.Width div Image.Width,
    Y * image.Picture.Bitmap.Height div Image.Height);
 MovePt := Point(X * image.Picture.Bitmap.Width div Image.Width,
    Y * image.Picture.Bitmap.Height div Image.Height);  Image.Canvas.MoveTo(X,Y);
  //Origin := Point(X,Y);
  //MovePt := Origin;
end;procedure TForm1.ImageMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, MovePt, pmNotXor);
    MovePt := Point(X * image.Picture.Bitmap.Width div Image.Width,
    Y * image.Picture.Bitmap.Height div Image.Height);
    DrawShape(Origin, MovePt, pmNotXor);
  end;
end;procedure TForm1.ImageMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Drawing then
  begin
    DrawShape(Origin, Point(X * image.Picture.Bitmap.Width div Image.Width,
    Y * image.Picture.Bitmap.Height div Image.Height), pmCopy);
    Drawing := False;
  end;
end;procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);
begin
  with Image.Canvas do
  begin
    Pen.Mode := AMode;
    Pen.Style:= psSolid;
    Image.Canvas.MoveTo(TopLeft.X, TopLeft.Y);
    Image.Canvas.LineTo(BottomRight.X, BottomRight.Y);
  end;
end;
end.

Answer 10

是，我也觉得是如此，看起来像虚线的原因是 缩放显示的 问题，你先在你的图片画一个像素宽度的线，然后在imgage控件里面显示，如果图像比imgage控件大，screch 是true ，线段就会变成像虚线一样。这个问题，如果楼主非要解决，最简单的，采取替代方法。在image1上放一个同样大小和位置image2，screch 为false，然后mousemove画线的操作在image2中完成，mouseup完成画线的时候再在image1中画线（注意坐标转换）。