关于图象的问题。。。给点思路??(100分)

  • 主题发起人 主题发起人 aliyan
  • 开始时间 开始时间
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(y),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.

 
移动图像;若你的IMAGE放在TPanel上,就将Panel1.DoubleBuffered:=true,否则就设
Form的DoubleBuffered:=true。要改变鼠标状态,改Screen.Cursor就行了,下面代码都
有,你试试看吧。

var
SecondPic:TPicture;
Position,FirstPt : TPoint;
Down : Boolean;
cx,cy:Integer;

procedure TForm2.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var now:TPoint;
begin
if Down then
with Image1 do
begin
Now.X:=Position.X + X - FirstPt.X;
Now.Y:=Position.Y + Y - FirstPt.Y;
if Now.X>0 then Now.X:=0;
if Now.Y>0 then Now.Y:=0;
if Now.X<-Cx then Now.X:=-Cx;
if Now.Y<-Cy then Now.Y:=-Cy;
Canvas.Pen.color := clBtnFace;
Canvas.Brush.color := clBtnFace;
Canvas.Rectangle(0,0,Image1.Width,Image1.Height);
Canvas.Draw(Now.X,Now.Y,SecondPic.Graphic);
Canvas.Draw(0,0,Picture.Graphic);
refresh;
end;
end;

procedure TForm2.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Down := TRUE;//我没有判断哪个键,你自己判断了。
FirstPt := Point(X,Y);
Screen.Cursor:=crHandPoint;
end;

procedure TForm2.Image1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
Position := Point(Position.X + X - FirstPt.X,Position.Y + Y - FirstPt.Y);
Down:=False;
Screen.Cursor:=crArrow;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
SecondPic:=TPicture.Create;
SecondPic.Assign(Image1.Picture);//若你是动态改图片,要改在动态变图片的地方
Position := Point(0,0);
Down := FALSE;
Cx:=Picture.Width-Image1.Width;
Cy:=Picture.Height-Image1.Height;
end;
 
:关于图象的问题。。。给点思路?? ( 积分:100, 回复:1, 阅读:38 )
分类:图形图象 ( 版主:卷起千堆雪tyn, menxin )
来自:aliyan, 时间:2001-11-15 17:37:00, ID:732151 | 编辑 [显示:小字体 | 大字体]


来自:zhangkan, 时间:2001-11-15 19:32:00, ID:732434


问题讨论没有结束 ...
aliyan,对此问题,您可以:

接受答案,并为 zhangkan 加上 100 点积分
接受答案,并分配积分

zhangkan

请注意分数总和应为 100 分

8 添加您对此问题的注释(请注意换行)

-------------------------------------------------
我只能看到这样的东东??
我怎么看内容呀??
 
你进错了门了
你是ie5。0 还是进稳健型m界 面吧
 
如果要改变 鼠标的型状
只要改变Screen.Cursor的值就行了
具体的值如下 也可以用其它你自定义的 鼠标3图型
crDefault 0 crNone -1
crArrow -2
crCross -3
crIBeam -4
crSizeNESW -6
crSizeNS -7
crSizeNWSE -8
crSizeWE -9
crUpArrow -10
crHourGlass -11
crDrag -12
crNoDrop -13

crHSplit -14
crVSplit -15
crMultiDrag -16
crSQLWait -17
crNo -18
crAppStart -19
crHelp -20
crHandPoint -21
crSize -22 (obsolete)
crSizeAll -22
 
到我的问题
http://www.delphibbs.com/delphibbs/dispq.asp?lid=740754
里看源码,关于你的问题已经解决,可惜我的问题还有待继续深入。
估计你不会用到我那么大图像。
 
你可以借本delhi的多媒体编程参考看看,对图象可以做很多处理,不知道你的问题是
什么?我最近刚好在做一个老师布置的图象处理的小程序。有兴趣共同探讨。
qq:173985738
 

Similar threads

I
回复
0
查看
556
import
I
I
回复
0
查看
701
import
I
I
回复
0
查看
713
import
I
后退
顶部