程序刚刚发出,如果收不到,下面是代码,需要一个image,一个button用于装jpg格式的图像
,一个opendiag;
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, jpeg, StdCtrls, AxCtrls, OleCtrlsComCtrls;
type
TForm1 = class(TForm)
Imagebmp: TImage;
Button1: TButton;
Opend: TOpenDialog;
procedure ImagebmpMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ImageBmpMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ImageBmpMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Down : Boolean;
FtPt,CurPt : TPoint;
implementation
{$R *.DFM}
procedure TForm1.ImageBmpMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
k:Tpoint;
begin
K:=mouse.CursorPos;//绝对座标
down := TRUE;
Ftpt:=Imagebmp.screentoclient(k);
curpt:=Imagebmp.screentoclient(k);
with Imagebmp do
begin
Canvas.Pen.Mode := pmnot;
Canvas.Pen.color:=clblack;
Canvas.Brush.Style := bsClear;
Canvas.pen.Style:=psdot;
end;
end;
procedure TForm1.ImageBmpMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
k:Tpoint;
begin
k:=mouse.CursorPos;
if down=false then exit;
with Imagebmp do
begin
Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);
end;
curpt:=Imagebmp.screentoclient(k);
ImageBmp.Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);
end;
procedure TForm1.ImageBmpMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := FALSE;
with Imagebmp do
begin
Canvas.pen.Style:=psdashdot;
Canvas.Pen.Mode := pmcopy;
Canvas.Rectangle(FtPt.X,FtPt.Y,CurPt.X,CurPt.Y);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
jpg:Tjpegimage;
bmp:Tbitmap;
begin
if opend.Execute then
begin
jpg:=Tjpegimage.Create;
bmp:=Tbitmap.Create;
jpg.LoadFromFile(opend.filename);
bmp.Assign(jpg);
imagebmp.picture.Assign(bmp);
end;
end;
end.