【delphi开源代码栏目提醒】:网学会员--在 delphi开源代码编辑为广大网友搜集整理了:dldw.pas绩等信息,祝愿广大网友取得需要的信息,参考学习。
unit dldw;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, jpeg, DB, ADODB, Grids, DBGrids,
StdCtrls;
type
Tf_dldw = class(TForm)
entireimage: TImage;
PopupMenu1: TPopupMenu;
N10: TMenuItem;
N11: TMenuItem;
Timer1: TTimer;
khxxGrid: TDBGrid;
DataSource1: TDataSource;
tsxx: TMemo;
ADOQuery1: TADOQuery;
ADOQuery2: TADOQuery;
procedure FormShow(Sender: TObject);
Procedure AddShape(x,y: Integer;Hint: String;Tag: Integer);
procedure N10Click(Sender: TObject);
procedure entireimageMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormConstrainedResize(Sender: TObject; var MinWidth,
MinHeight, MaxWidth, MaxHeight: Integer);
procedure Timer1Timer(Sender: TObject);
procedure khxxGridDblClick(Sender: TObject);
procedure entireimageClick(Sender: TObject);
procedure entireimageMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure entireimageDragOver(Sender, Source: TObject; X, Y: Integer;
State: TDragState; var Accept: Boolean);
procedure Shape1EndDrag(Sender, Target: TObject; X, Y: Integer);
procedure N11Click(Sender: TObject);
procedure FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
procedure ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
{ Public declarations }
Function MakeTag: Integer; //自动生成Tag
Function FormContainShape: Boolean; //判断窗体中是否包含TShape组件
end;
khxx = record
khdm: String;//客户编号
khmc: String;//客户名称
fzr: String;//负责人
ksb: String;//课税别
wz: String;//网址
hint: String;//提示信息
x: integer;
y: integer;
tag: Integer;
end;
var
f_dldw: Tf_dldw;
arrkhxx: khxx;
x1: Integer = 0; //记录表格出现的位置
y1: Integer = 0; //...
FormWidth: Integer = 0;
FormHeight: Integer = 0;
bl: ReaL = 1.0;//图片宽度与窗体宽度的比
Drag: Boolean = False;//确定是否拖动图标
Dragx: Integer = 0;
Dragy: Integer = 0;
Movetag: Integer = -1;//鼠标在TShape组件上移动时,记录TShape组件的Tag属性,用于删除操作
implementation
{$R *.dfm}
procedure Tf_dldw.AddShape(x,y: Integer;Hint: String;tag: Integer);
var
Shape: TShape;
begin
Try
Shape := TShape.Create(nil);
Shape.Parent := self;
Shape.Pen.Color := clblue;
Shape.Pen.Width := 3;
Shape.Width := 30;
Shape.Height := 30;
Shape.Tag := Tag;
Shape.Shape := stCircle;
Shape.Brush.Style := bsClear;
Shape.OnEndDrag := Shape1EndDrag;
Shape.DragMode := dmAutomatic;
Shape.OnMouseMove := ShapeMouseMove;
Shape.Left := (EntireImage.Left)+x-Trunc(Shape.Width/2);
Shape.Top := (EntireImage.Top)+y-Trunc(Shape.Height/2);
Shape.Show;
Except
Application.MessageBox('添加标记失败.','提示',64);
End;
end;
procedure Tf_dldw.FormShow(Sender: TObject);
begin
if FileExists(extractFilePath(Application.ExeName)+'map\changchun.jpg') = True then
EntireImage.Picture.LoadFromFile(extractFilePath(Application.ExeName)+'\map\changchun.jpg')
else
Application.MessageBox('图片文件不存在.','提示',64);
EntireImage.Left := 0;
EntireImage.Top := 0;
with ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('select a.*,b.khmc,b.fzr,b.ksb,b.wz from t_khdldw a inner join t_khzl b on a.khdm = b.khdm ');
Open;
end;
if ADOQuery1.RecordCount>0 then
begin
while Not ADOQuery1.Eof do
begin
arrkhxx.khdm := Trim(ADOQuery1.FieldByName('khdm').AsString);
arrkhxx.x := ADOQuery1.FieldByName('x').AsInteger;
arrkhxx.y := ADOQuery1.FieldByName('y').AsInteger;
arrkhxx.tag := ADOQuery1.FieldByName('tag').AsInteger;
arrkhxx.fzr := Trim(ADOQuery1.FieldByName('fzr').AsString);
arrkhxx.ksb := Trim(ADOQuery1.FieldByName('ksb').AsString);
arrkhxx.wz := Trim(ADOQuery1.FieldByName('wz').AsString);
arrkhxx.hint := Trim(ADOQuery1.FieldByName('hint').AsString);
AddShape(arrkhxx.x,arrkhxx.y,arrkhxx.hint,Arrkhxx.tag);
ADOQuery1.Next;
end;
end;
end;
procedure Tf_dldw.N10Click(Sender: TObject);
var
GridLeft,GridTop: Integer;
begin
with ADOQuery2 do
begin
Close;
SQL.Clear;
SQL.Add('Select b.khdm,b.khmc,b.fzr,b.ksb,b.wz from t_khzl b where b.khdm not in(select khdm from t_khdldw)');
Open;
end;
if ADOQuery2.RecordCount>0 then
begin
GridLeft:= EntireImage.Left+ x1;
GridTop:= EntireImage.Top+ y1;
if (GridLeft + khxxGrid.Width)>Width then
GridLeft := GridLeft - khxxGrid.Width;
if (GridTop + khxxGrid.Height) >Height then
GridTop := GridTop - khxxGrid.Height;
DataSource1.DataSet := ADOQuery2;
KhxxGrid.Left := GridLeft;
KhxxGrid.Top := GridTop;
KhxxGrid.Visible := True;
end
else
begin
KhxxGrid.Visible := False;
DataSource1.DataSet := Nil;
Application.MessageBox('当前没有可定位的客户资料.','提示',64);
end;
end;
procedure Tf_dldw.entireimageMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
x1 := x;
y1 := y;
end;
procedure Tf_dldw.FormConstrainedResize(Sender: TObject; var MinWidth,
MinHeight, MaxWidth, MaxHeight: Integer);
begin
MaxWidth := EntireImage.Width;
MaxHeight := EntireImage.Height;
end;
procedure Tf_dldw.Timer1Timer(Sender: TObject);
var
i: Integer;
begin
For i := 0 to ControlCount-1 do
if Controls[i] is TShape then
begin
if TShape(Controls[i]).Pen.Color = clBlue then
TShape(Controls[i]).Pen.Color := clRed
else if TShape(Controls[i]).Pen.Color = clRed then
TShape(Controls[i]).Pen.Color := clBlue;
end;
end;
procedure Tf_dldw.khxxGridDblClick(Sender: TObject);
var
Hint: String;
shapeTag: Integer;
begin
Hint := '客户代码: '+Trim(ADOQuery2.FieldByName('khdm').AsString)+' ; 客户名称: '+
Trim(ADOQuery2.FieldByName('khmc').AsString)+ ' ; 负责人: '+Trim(ADOQuery2.FieldByName('fzr').AsString)+
' ; 课税别: '+ Trim(ADOQuery2.FieldByName('ksb').AsString)+ ' ; 网址: '+ Trim(ADOQuery2.FieldByName('wz').AsString);
ShapeTag := MakeTag;
AddShape(x1,y1,Hint,ShapeTag);
Try
With ADOQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('Insert t_khdldw values (:a,:b,:c,:d,:e)');
Parameters.ParamByName('a').Value := Trim(ADOQuery2.FieldByName('khdm').AsString);
Parameters.ParamByName('b').Value := x1;
Parameters.ParamByName('c').Value := y1;
Parameters.ParamByName('d').Value := ShapeTag;
Parameters.ParamByName('e').Value := Trim(Hint);
ExecSQL;
end;
khxxGrid.Visible := False;
Application.MessageBox('操作成功.','提示',64);
Except
Application.MessageBox('操作失败.','提示',64);
end;
end;
procedure Tf_dldw.entireimageClick(Sender: TObject);
begin
if khxxGrid.Visible = True then
KhxxGrid.Visible := False;
Drag := False;
end;
procedure Tf_dldw.ShapeMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
tsxxLeft,tsxxTop: Integer;
Rect: TRect;
begin
if Drag = Fals
上一篇:
EmployeeInfoDataSet.cpp
下一篇:
AF内固定椎体内植骨治疗胸腰椎骨折