A
aliyan
Unregistered / Unconfirmed
GUEST, unregistred user!
我现在想当鼠标右键按下不放,移到新位置在放开时,图象被移到新位置。。这个功能已经实现。。
我想鼠标在这个移动的过程中图标跟着鼠标移动。。。
我想改变鼠标的形状。。。可是不知道怎么做??
代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, jpeg, StdCtrls, Buttons, Db, DBTables, Grids, DBGrids;
type
jfvt=array[1..200,1..3] of string;
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
DataSource1: TDataSource;
Query1: TQuery;
Database1: TDatabase;
ComboBox1: TComboBox;
//
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtn2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
Procedure jfvtini(sender: TObject);
Procedure createIcon(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
add,del,move:integer;
i,r:Integer; //
bids:string;
jfimage:jfvt;
dx,dy:integer;
implementation
uses M_jxboxes_add_edit, Global;
{$R *.DFM}
Procedure TForm1.jfvtini(sender: TObject);
begin
Combobox1.Clear ;
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('select bid,x,y from maps');
open;
end;
i:=0;
while not Query1.Eof do
begin
i:=i+1;
jfimage[i,1]:=Query1.fieldByName('bid').AsString;
jfimage[i,2]:=Query1.fieldByName('x').AsString;
jfimage[i,3]:=Query1.fieldByName('y').AsString;
if (jfimage[i,2]='') and (jfimage[i,3]='') then Combobox1.Items.Add(jfimage[i,1]) ;
Query1.Next ;
end;
end;
Procedure TForm1.createIcon(sender: TObject);
var
j:integer;
x,y:string;
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.Loadfromfile('image/title.ico');
image1.Canvas.CopyMode :=cmSrcInvert;
for j:=1 to i do
begin
x:=jfimage[j,2];
y:=jfimage[j,3];
if (x<>'') and (y<>'') then image1.Canvas.Draw(StrToint(x),StrToint,Icon) ;
end;
Icon.Free;
end;
//窗口的创建
procedure TForm1.FormCreate(Sender: TObject);
begin
try
//连接数据库
Database1.Params.Values['USERNAME']:='omt';
Database1.Params.Values['PASSWORD']:='omt';
Database1.LoginPrompt:=False;
Database1.DatabaseName:='jxdb';
Database1.AliasName:='jxdb';
except
on EDatabaseError do messageDlg('000对不起没有边上数据库或者连接数据库错误!',mtinformation,[mbOk],0);
end;
Query1.DatabaseName :='jxdb';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
add:=1;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
j:integer;
x1,x2,y1,y2:integer;
begin
if button=mbleft then //如果是鼠标左键则显示信息
begin
//不是添加不是删除,则是查看
if (del=0) and (add=0) then
begin
dx:=x;
dy:=y;
Abort;
end;
if add=1 then
begin
bids:=combobox1.Text ;
if bids='' then
begin
showmessage('对不起,你没有选择交接箱编码!');
Abort;
end
else
begin
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x=:x,y=:y where bid=:bids');
ParamByName('x').AsInteger:=x;
ParamByName('y').AsInteger:=y;
ParamByName('bids').AsString:=bids;
ExecSQl;
end;
add:=0;
Query1.close;
jfvtini(sender);
createIcon(sender);
abort;
end;
end ;
//删除查看
if del=1 then ///删除
begin
for j:=1 to i do
begin
x1:=StrToint(jfimage[j,2]);
x2:=StrToint(jfimage[j,2])+32 ;
y1:=StrToint(jfimage[j,3]);
y2:=StrToint(jfimage[j,3])+32;
if ((x>=x1) and (x<=x2)) and ((y>=y1) and (y<=y2)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x='''',y='''' where bid=:b_id');
ParamByName('b_id').AsString:=Evalue;
ExecSQL;
end;
Image1.Picture.LoadFromFile('image/map.bmp');
jfvtini(sender);
createIcon(sender);
DEl:=0;
abort;
end
else
cursor:=crDefault;
end;
end;
end;
if button=mbright then //如果是右键则触发移动事件
begin
for j:=1 to i do
begin
if ((x>=StrToint(jfimage[j,2])) and (x<=StrToint(jfimage[j,2])+32)) and ((y>=StrToint(jfimage[j,3])) and (y<=StrToint(jfimage[j,3])+32)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
r:=1;
abort;
end
else
cursor:=crDefault;
end ;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
j:integer;
xx,yy:string;
begin
Edit1.Text :=intTostr(X);
Edit2.Text :=IntToStr(Y);
for j:=1 to i do
begin
xx:=jfimage[j,2];
yy:=jfimage[j,2];
if (xx<>'') and (yy<>'') then
begin
if ((x>=StrToint(xx)) and (x<=StrToint(xx)+32)) and ((y>=StrToint(yy)) and (y<=StrToint(yy)+32)) then
begin
cursor:=crDrag ;
Abort;
end
else
cursor:=crDefault;
end;
end
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
del:=1;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
jfvtini(sender);
createIcon(sender);
end;
procedure TForm1.Image1DblClick(Sender: TObject);
var
j:integer;
x1,x2,y1,y2:integer;
begin
for j:=1 to i do
begin
x1:=StrToint(jfimage[j,2]);
x2:=StrToint(jfimage[j,2])+32 ;
y1:=StrToint(jfimage[j,3]);
y2:=StrToint(jfimage[j,3])+32;
if ((dx>=x1) and (dx<=x2)) and ((dy>=y1) and (dy<=y2)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
dx:=0;
dy:=0;
F_jxboxes_add_edit.Show
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if r=1 then
begin
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x=:x,y=:y where bid=:bids');
ParamByName('x').AsInteger:=x;
ParamByName('y').AsInteger:=y;
ParamByName('bids').AsString:=Evalue;
ExecSql;
end;
r:=0;
Image1.Picture.LoadFromFile('image/map.bmp');
jfvtini(sender);
createIcon(sender);
end;
end;
end.
我想鼠标在这个移动的过程中图标跟着鼠标移动。。。
我想改变鼠标的形状。。。可是不知道怎么做??
代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, jpeg, StdCtrls, Buttons, Db, DBTables, Grids, DBGrids;
type
jfvt=array[1..200,1..3] of string;
TForm1 = class(TForm)
Image1: TImage;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Button1: TButton;
Button2: TButton;
DataSource1: TDataSource;
Query1: TQuery;
Database1: TDatabase;
ComboBox1: TComboBox;
//
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure BitBtn2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Image1DblClick(Sender: TObject);
procedure Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
Procedure jfvtini(sender: TObject);
Procedure createIcon(Sender: TObject);
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
add,del,move:integer;
i,r:Integer; //
bids:string;
jfimage:jfvt;
dx,dy:integer;
implementation
uses M_jxboxes_add_edit, Global;
{$R *.DFM}
Procedure TForm1.jfvtini(sender: TObject);
begin
Combobox1.Clear ;
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('select bid,x,y from maps');
open;
end;
i:=0;
while not Query1.Eof do
begin
i:=i+1;
jfimage[i,1]:=Query1.fieldByName('bid').AsString;
jfimage[i,2]:=Query1.fieldByName('x').AsString;
jfimage[i,3]:=Query1.fieldByName('y').AsString;
if (jfimage[i,2]='') and (jfimage[i,3]='') then Combobox1.Items.Add(jfimage[i,1]) ;
Query1.Next ;
end;
end;
Procedure TForm1.createIcon(sender: TObject);
var
j:integer;
x,y:string;
Icon: TIcon;
begin
Icon := TIcon.Create;
Icon.Loadfromfile('image/title.ico');
image1.Canvas.CopyMode :=cmSrcInvert;
for j:=1 to i do
begin
x:=jfimage[j,2];
y:=jfimage[j,3];
if (x<>'') and (y<>'') then image1.Canvas.Draw(StrToint(x),StrToint,Icon) ;
end;
Icon.Free;
end;
//窗口的创建
procedure TForm1.FormCreate(Sender: TObject);
begin
try
//连接数据库
Database1.Params.Values['USERNAME']:='omt';
Database1.Params.Values['PASSWORD']:='omt';
Database1.LoginPrompt:=False;
Database1.DatabaseName:='jxdb';
Database1.AliasName:='jxdb';
except
on EDatabaseError do messageDlg('000对不起没有边上数据库或者连接数据库错误!',mtinformation,[mbOk],0);
end;
Query1.DatabaseName :='jxdb';
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
add:=1;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
j:integer;
x1,x2,y1,y2:integer;
begin
if button=mbleft then //如果是鼠标左键则显示信息
begin
//不是添加不是删除,则是查看
if (del=0) and (add=0) then
begin
dx:=x;
dy:=y;
Abort;
end;
if add=1 then
begin
bids:=combobox1.Text ;
if bids='' then
begin
showmessage('对不起,你没有选择交接箱编码!');
Abort;
end
else
begin
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x=:x,y=:y where bid=:bids');
ParamByName('x').AsInteger:=x;
ParamByName('y').AsInteger:=y;
ParamByName('bids').AsString:=bids;
ExecSQl;
end;
add:=0;
Query1.close;
jfvtini(sender);
createIcon(sender);
abort;
end;
end ;
//删除查看
if del=1 then ///删除
begin
for j:=1 to i do
begin
x1:=StrToint(jfimage[j,2]);
x2:=StrToint(jfimage[j,2])+32 ;
y1:=StrToint(jfimage[j,3]);
y2:=StrToint(jfimage[j,3])+32;
if ((x>=x1) and (x<=x2)) and ((y>=y1) and (y<=y2)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x='''',y='''' where bid=:b_id');
ParamByName('b_id').AsString:=Evalue;
ExecSQL;
end;
Image1.Picture.LoadFromFile('image/map.bmp');
jfvtini(sender);
createIcon(sender);
DEl:=0;
abort;
end
else
cursor:=crDefault;
end;
end;
end;
if button=mbright then //如果是右键则触发移动事件
begin
for j:=1 to i do
begin
if ((x>=StrToint(jfimage[j,2])) and (x<=StrToint(jfimage[j,2])+32)) and ((y>=StrToint(jfimage[j,3])) and (y<=StrToint(jfimage[j,3])+32)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
r:=1;
abort;
end
else
cursor:=crDefault;
end ;
end;
end;
procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
j:integer;
xx,yy:string;
begin
Edit1.Text :=intTostr(X);
Edit2.Text :=IntToStr(Y);
for j:=1 to i do
begin
xx:=jfimage[j,2];
yy:=jfimage[j,2];
if (xx<>'') and (yy<>'') then
begin
if ((x>=StrToint(xx)) and (x<=StrToint(xx)+32)) and ((y>=StrToint(yy)) and (y<=StrToint(yy)+32)) then
begin
cursor:=crDrag ;
Abort;
end
else
cursor:=crDefault;
end;
end
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
del:=1;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
jfvtini(sender);
createIcon(sender);
end;
procedure TForm1.Image1DblClick(Sender: TObject);
var
j:integer;
x1,x2,y1,y2:integer;
begin
for j:=1 to i do
begin
x1:=StrToint(jfimage[j,2]);
x2:=StrToint(jfimage[j,2])+32 ;
y1:=StrToint(jfimage[j,3]);
y2:=StrToint(jfimage[j,3])+32;
if ((dx>=x1) and (dx<=x2)) and ((dy>=y1) and (dy<=y2)) then
begin
cursor:=crDrag ;
Evalue:=jfimage[j,1];
dx:=0;
dy:=0;
F_jxboxes_add_edit.Show
end;
end;
end;
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if r=1 then
begin
with Query1 do
begin
close;
Sql.Clear ;
Sql.Add('update maps set x=:x,y=:y where bid=:bids');
ParamByName('x').AsInteger:=x;
ParamByName('y').AsInteger:=y;
ParamByName('bids').AsString:=Evalue;
ExecSql;
end;
r:=0;
Image1.Picture.LoadFromFile('image/map.bmp');
jfvtini(sender);
createIcon(sender);
end;
end;
end.