|
摘 要 本文介绍了在Delphi环境中实现非矢量图形标绘的简便方法，并给出了程序环境设计与具体代码实现。
关键词 Delphi，非矢量图形，标绘
一、前言
相对于语言文字来说，图形能把一定具体共同空间形式及特征的事物形象而概括地表示出来，不仅简化文字叙述，节省时间，而且形象直观，一目了然。在港口码头舰船靠泊、机场飞机驻屯、车场管理等工作中，管理人员需要实时掌握泊位、机位、车位的占用情况，而通过图形标绘能够将舰船、飞机、车辆的停靠情况标注在码头、机场、车场示意图上，让管理人员及时掌握整体情况，进行科学高效管理。
本文介绍了在Delphi环境下实现非矢量图形标绘的简便方法，其实现思路为：根据特定参数动态创建图标控件，并使其支持鼠标拖放操作；在退出系统时，把所有标绘的图标信息（种类、标题、序号和位置）保存至配置文件中，在下一次进入系统时则先读取配置文件，恢复显示上一次退出前所有标绘的图标。
二、窗体设计
程序实验环境如下：
(1)操作系统：Windows XP Professional SP2。
(2)开发环境：Delphi 7.0 + Raize Components 3.11控件包。
1．主窗体Form1
用Delphi新建一个项目Test，并创建主窗体Form1，其属性Caption设为“简易图形标绘系统”。
在窗体中放置一个ImageList控件，并导入相关的图片，如图1：
在窗体中放置一个GroupBox控件，其属性Caption设为“军标”，属性Align设为alLeft。在GroupBox1上放置一个ListView控件，属性LargeImages设为ImageList1，属性OwnerDraw设为True，并增加ListView1的Item项，Item1的属性Caption设为“常规潜艇”，属性ImageIndex设为0，Item2的属性Caption设为“核潜艇”，属性ImageIndex设为1，Item3的属性Caption设为“驱逐舰”，属性ImageIndex设为2，Item4的属性Caption设为“护卫舰”，属性ImageIndex设为3。
在窗体中放置三个BitBtn控件，第一个的属性Caption设为“更换地图”，第二个的属性Caption设为“图标属性”，第三个的属性Caption设为“清除图标”。
在窗体中放置两个RzToolButton控件，第一个的属性Caption设为“种子控件”，属性Name设为RzToolButton_，属性Visible设为False，第二个的属性Visible也设为False。
在窗体中放置一个ScrollBox控件，属性Align设为alClient，在其上放置一个Image控件，属性Align设为alClient，并设置Image1的Picture属性（导入一幅电子地图图片）。
在窗体中放置一个OpenPictureDialog控件，属性Filter设为“All (*.jpg;*.jpeg;*.bmp)|*.jpg;*.jpeg;*.bmp | JPEG Image File (*.jpg)|*.jpg|JPEG Image File (*.jpeg)|*.jpeg|Bitmaps (*.bmp)|*.bmp”。
主窗体的设计效果如图2所示：
2.属性窗体Form2
在项目中创建属性窗体Form2，窗体中放置一个Label、一个Edit和一个BitBtn控件，设计效果如图3所示。
三、代码实现
1．公共变量定义
bFirstEnter, bBackground: Boolean; //是否第一次进入，是否更换电子地图图片
SelfDir, sCaption: string; //程序目录, 图标Caption
myIniFile: string; //图标配置文件
rwIniFile: TIniFile; //读写图标配置文件
iXh, iImageIndex, iCurObject: Integer; //图标序号, 图标ImageIndex, 当前图标的对象编号
cxVarObject: Array [0..99] of TRzToolButton;//图标新标号
cxSelObject: TRzToolButton; //种子图标
myControl: TControl; //当前图标
XX, YY: Integer; //当前图标的新位置
2．图标对象的初始化与存取
procedure TForm1.FormCreate(Sender: TObject);
begin
SelfDir := ExtractFilePath(Paramstr(0)); //当前目录
myIniFile := SelfDir + 'System.ini'; //配置文件
bFirstEnter := False; //登录标志
bBackground := False; //更换电子地图图片标志
iXh := 1; //创建的图标标识数
iCurObject := 0; //当前图标的对象编号
ScrollBox1.DoubleBuffered := True; //防止拖动控件时图片闪烁
end;
//判读是否为首次进入系统，若为首次登录则读取图标配置文件，调用创建图标的事件，恢复显示上一次退出前所有标绘的图标
procedure TForm1.FormShow(Sender: TObject);
var
i, iLeft, iTop, icount: Integer;
sName: string;
Shift: TShiftState;
begin
if bFirstEnter then
Exit;
if FileExists(myIniFile) then
begin
rwIniFile := TIniFile.Create(myIniFile); //读取图标配置文件
icount := rwIniFile.ReadInteger('Control', 'Count', 0); //图标个数
for i := 1 to icount do
begin
sName := rwIniFile.Readstring(IntToStr(i), 'Name', ''); //图标Name
if Length(sName) > 0 then
begin
cxSelObject := RzToolButton_; //图标的父继承控件
sCaption := rwIniFile.Readstring(IntToStr(i), 'Caption', ''); //图标Caption
iImageIndex := rwIniFile.ReadInteger(IntToStr(i), 'ImageIndex', 0);//图标ImageIndex'
iLeft := rwIniFile.ReadInteger(IntToStr(i), 'Left', 0); //图标Left
iTop := rwIniFile.ReadInteger(IntToStr(i), 'Top', 0); //图标Top
Image1MouseDown(Sender, mbLeft, Shift, iLeft, iTop); //-调用创建图标事件-
end
else
cxSelObject := nil;
end;
rwIniFile.Free;
end;
bFirstEnter := True;
end;
//退出系统时，把所有标绘的图标信息（种类、标题、序号和位置）保存至配置文件中
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
i, iPos, iImageIndex: Integer;
aOwner: TControl;
sHint, sCaption: string;
begin
rwIniFile := TIniFile.Create(myIniFile); //存取的配置文件名
rwIniFile.WriteInteger('Control', 'Count', ScrollBox1.ControlCount - 1);//图标个数（Image1除外）
for i := 0 to ScrollBox1.ControlCount - 1 do //该控件内的所有子控件
begin
aOwner := ScrollBox1.Controls[i];
if aOwner is TRzToolButton then //符合类型的图标控件
begin
sHint := aOwner.Hint;
iPos := Pos(Chr(1), sHint);
sCaption := Copy(sHint, 1, iPos - 1);
iImageIndex := StrToInt(Copy(sHint, iPos + 1, Length(sHint) - Length(sCaption) - 1));
rwIniFile.WriteString(IntToStr(i), 'Name', aOwner.Name);
rwIniFile.WriteString(IntToStr(i), 'Caption', sCaption);
rwIniFile.WriteInteger(IntToStr(i), 'ImageIndex', iImageIndex);
rwIniFile.WriteInteger(IntToStr(i), 'Left', aOwner.Left);
rwIniFile.WriteInteger(IntToStr(i), 'Top', aOwner.Top);
end;
end;
rwIniFile.Free;
CanClose := True;
end;
3．拖曳图标的鼠标事件
//设置指定控件处理鼠标事件
procedure TForm1.ControlMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
iPos: Integer;
sName: string;
begin
myControl := TControl(Sender);
SetCaptureControl(myControl);
XX := X;
YY := Y;
if (myControl is TRzToolButton) then //获得鼠标右键单击时的当前图标标识
begin
iPos := Pos('_', myControl.Name);
sName := Copy(myControl.Name, 1, iPos - 1);
iCurObject := StrToInt(Copy(myControl.Name, iPos + 1, Length(myControl.Name) - Length(sName) - 1));
end;
end;
//获得正在处理鼠标事件的控件，并定位到新位置
procedure TForm1.ControlMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
myControl := GetCaptureControl;
if myControl = nil then
Exit;
myControl.Left := myControl.Left + X - XX;
myControl.Top := myControl.Top + Y - YY;
end;
//释放鼠标事件
procedure TForm1.ControlMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
ReleaseCapture;
end;
//延时事件，用于当前图标的闪烁事件
procedure HaveSigned(MaxWaitTime: Cardinal);
var
WaitedTime: Cardinal;
begin
WaitedTime := 0;
while (WaitedTime < MaxWaitTime) do
begin
SleepEx(100, False);
Inc(WaitedTime, 100);
Application.ProcessMessages ;
end;
end;
//当前图标的闪烁事件
procedure TForm1.RzToolButtonWink(Sender: TObject);
begin
if ((Sender as TRzToolButton).Name <> 'RzToolButton1') then
begin
iCurObject := (Sender as TRzToolButton).Tag;
(Sender as TRzToolButton).Visible := False;
HaveSigned(200);
(Sender as TRzToolButton).Visible := True;
HaveSigned(200);
(Sender as TRzToolButton).Visible := False;
HaveSigned(200);
(Sender as TRzToolButton).Visible := True;
end;
end;
4、根据鼠标点击所传递的参数，动态创建图标
//根据鼠标点击ListView的Item项传递创建图表所需的相关参数
procedure TForm1.ListView1Click(Sender: TObject);
begin
if ListView1.ItemIndex < 0 then
Exit;
cxSelObject := RzToolButton_; //图标的种子（父亲）控件
sCaption := ListView1.Items[ListView1.ItemIndex].Caption; //图标Caption
iImageIndex := ListView1.Items[ListView1.ItemIndex].ImageIndex;//图标ImageIndex
end;
//根据参数动态创建图标
procedure TForm1.Image1MouseDown(Sender:TObject; Button:TMouseButton; Shift:TShiftState; X,Y: Integer);
var
i: Integer;
begin
if cxSelObject = nil then
Exit;
Image1.Cursor := crCross;
if (iXh > 100) then
begin
Application.MessageBox('创建的图标对象已超过100个！', '提示', MB_OK+MB_ICONINFORMATION);
Exit;
end;
if cxSelObject <> RzToolButton1 then
begin
//连续序号
for i := 1 to 99 do
begin
if cxVarObject[i] = nil then
begin
iXh := i;
Break;
end;
end;
//创建选择的图标对象
//设置图标的属性
cxVarObject[iXh] := TRzToolButton.Create(Application);
cxVarObject[iXh].Name := cxSelObject.Name + IntToStr(iXh); //名称
cxVarObject[iXh].Parent := ScrollBox1;
cxVarObject[iXh].Left := X; // Left
cxVarObject[iXh].Top := Y; // Top
cxVarObject[iXh].Width := cxSelObject.Width; //长度Width
cxVarObject[iXh].Height := cxSelObject.Height; //高度Height
cxVarObject[iXh].Layout := blGlyphTop; //图标的图片布局
cxVarObject[iXh].Caption := sCaption; //Caption
cxVarObject[iXh].ShowCaption := True;
cxVarObject[iXh].Images := cxSelObject.Images; //图标的图片
cxVarObject[iXh].ImageIndex := iImageIndex;
cxVarObject[iXh].Hint := sCaption + Chr(1) + IntToStr(iImageIndex);//图标的提示信息
cxVarObject[iXh].ShowHint := False;
cxVarObject[iXh].Cursor := crHandPoint; //光标
cxVarObject[iXh].Visible := True;
cxVarObject[iXh].Tag := iXh;
iCurObject := iXh; //图标序号
设置图标的事件
cxVarObject[iXh].OnMouseDown := ControlMouseDown;//控件移动的鼠标事件
cxVarObject[iXh].OnMouseMove := ControlMouseMove ;
cxVarObject[iXh].OnMouseUp := ControlMouseUp;
cxVarObject[iXh].OnClick := RzToolButtonWink; //闪烁事件
end;
cxSelObject := RzToolButton1; //转移鼠标焦点
Image1.SendToBack;
Image1.Cursor := crDefault;
end;
5．其他事件
//更换底图
procedure TForm1.BitBtn1Click(Sender: TObject);
var
MyJpegImage: TJpegImage;
MyBmp: TBitmap;
sFileName, sFileExt: string;
begin
if not OpenPictureDialog1.Execute then
Exit;
sFileName := OpenPictureDialog1.FileName;
sFileExt := Copy(sFileName, Length(sFileName) - 2, 3);
if (sFileExt = 'jpg') or (sFileExt = 'JPG') or (sFileExt = 'peg') or (sFileExt = 'PEG') then//若为JPG图片
begin
MyJpegImage := TJpegImage.Create;
try
MyJpegImage.LoadFromFile(sFileName);
Image1.Picture.Graphic := MyJpegImage;
finally
MyJpegImage.Free;
end;
end
else if (sFileExt = 'bmp') or (sFileExt = 'BMP') then//若为BMP图片
begin
MyBmp := TBitmap.Create;
try
MyBmp.LoadFromFile(sFileName);
Image1.Picture.Graphic := MyBmp;
finally
MyBmp.Free;
end;
end;
end;
//打开Form2窗体，设置当前图标的名称Caption属性
procedure TForm1.BitBtn2Click(Sender: TObject);
var
sCaption, sText: string;
iImageIndex: Integer;
begin
if (cxVarObject[iCurObject] <> nil) and (cxVarObject[iCurObject] is TRzToolButton) then
begin
//读取当前图标属性
sCaption := cxVarObject[iCurObject].Caption;
iImageIndex := cxVarObject[iCurObject].ImageIndex;
//闪烁当前图标
cxVarObject[iCurObject].Visible := False;
HaveSigned(150);
cxVarObject[iCurObject].Visible := True;
//打开"图标属性设置"窗口
Form2 := TForm2.Create(nil);
try
Form2.Edit1.Text := sCaption;
if Form2.ShowModal = MrOK then
begin
sText := Form2.Edit1.Text;
if sText <> sCaption then //比较变化情况
begin
cxVarObject[iCurObject].Caption := sText;
cxVarObject[iCurObject].Hint := sText + Chr(1) + IntToStr(iImageIndex);
end;
end;
finally
Form2.Free;
end;
end;
end;
//删除当前图标
procedure TForm1.BitBtn3Click(Sender: TObject);
begin
if cxVarObject[iCurObject] <> nil then
begin
//闪烁当前图标
cxVarObject[iCurObject].Visible := False;
HaveSigned(200);
cxVarObject[iCurObject].Visible := True;
//提示删除
if Application.MessageBox('确定删除当前图标吗？', '提示', MB_YESNO+MB_ICONWARNING) = IDYES then
if (cxVarObject[iCurObject].Parent = ScrollBox1) then
FreeAndNil(cxVarObject[iCurObject]);
end;
end;
四、结语
本文介绍了在Delphi环境下实现非矢量图形标绘的基本方法，主要给出了系统的窗体设计、图标的初始化与配置信息存取、图标创建与拖放、图标属性设置等图形标绘关键事件的代码实现，虽然总体功能还比较简单，但在实际的应用中可以根据需要进行修改与扩展，比如根据用户需求定制图标，对图标方向、大小、颜色等属性的动态调整，图标搜索及将图标信息与数据库数据关联等，应用范围将进一步扩大。
|
