Image 坐标转换(100)

我的Image空间大小事501*346大小的,载入2560*1920大小的图片;然后要在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;

你可以参考delphi5开发人员指南上的例子。专门有个完整的例子的。

楼主的代码没有问题啊。有几行代码好像是多余的。unit Unit1;interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls;type TForm1 = class(TForm) Image1: TImage; 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); private { Private declarations } procedure DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode); public { Public declarations } end;var Form1: TForm1; Drawing: Boolean; Origin, MovePt: TPoint; implementation{$R *.dfm}procedure TForm1.DrawShape(TopLeft, BottomRight: TPoint; AMode: TPenMode);begin with Image1.Canvas do begin Pen.Mode := AMode; Image1.Canvas.MoveTo(TopLeft.X, TopLeft.Y); Image1.Canvas.LineTo(BottomRight.X, BottomRight.Y); end; end;procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin Drawing := True; Image1.Canvas.MoveTo(X,Y); Origin := Point(X,Y); MovePt := Origin; end;procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);beginif Drawing then begin DrawShape(Origin, MovePt, pmNotXor); MovePt := Point(X, Y); DrawShape(Origin, MovePt, pmNotXor); end; end;procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin if Drawing then begin DrawShape(Origin, Point(X,Y), pmCopy); Drawing := False; end; end;end.

这样不行画出来的线都是在左上角 而且还是虚线!载入的图片比Image控件大!!!

没有啊。我的Image1里没有加载图片。如果加载了图片，好像不能直接画的，你把你的代码完整贴出来。

这是完整代码,现在能画出线,但是线是虚线!怎么样画成实线?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.

不是虚线，画的是斜线的话看起来是有点毛。如果画的是直线，就好了。下面这个是什么意思呢？Origin := Point(X * image.Picture.Bitmap.Width div Image.Width, Y * image.Picture.Bitmap.Height div Image.Height);

那个事坐标转换的

那个代码好像有问题

接受答案了.