📄 unitcominfo.~pas
字号:
unit UnitComInfo;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, Buttons, MapXLib_TLB, DB, Mask;
type
TFrmComInfo = class(TForm)
LEditName: TLabeledEdit;
MemoIntroduction: TMemo;
TimerInfo: TTimer;
LabelInfo: TLabel;
BBtnEdit: TBitBtn;
BBtnExport: TBitBtn;
BBtnCancel: TBitBtn;
BBtnDelete: TBitBtn;
CBoxType: TComboBox;
LabelType: TLabel;
procedure WMNCPaint(var Msg: TWMNCPaint); message WM_NCPAINT;
procedure FillFeatureData(TableName: String);
procedure FormShow(Sender: TObject);
procedure TimerInfoTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure BBtnEditClick(Sender: TObject);
procedure FillData();
procedure BBtnExportClick(Sender: TObject);
procedure BBtnDeleteClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BBtnCancelClick(Sender: TObject);
procedure CBoxTypeChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmComInfo: TFrmComInfo;
OnShowing: Boolean;
implementation
uses UnitMain, UnitDataModule, UnitModify, UnitCommonModule,
UnitSearchResult;
{$R *.dfm}
// 画窗体边框
procedure TFrmComInfo.WMNCPaint(var Msg: TWMNCPaint);
var
dc : hDc;
Pen : hPen;
OldPen : hPen;
OldBrush : hBrush;
begin
inherited;
dc := GetWindowDC(Handle);
msg.Result := 1;
Pen := CreatePen(PS_SOLID, 2, RGB(255, 0, 0));
OldPen := SelectObject(dc, Pen);
OldBrush := SelectObject(dc, GetStockObject(NULL_BRUSH));
if OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height+5);
if Not TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height);
if Not OnShowing and TimerInfo.Enabled then Windows.Rectangle(dc, 0, 0, Width, Height-5);
SelectObject(dc, OldBrush);
SelectObject(dc, OldPen);
DeleteObject(Pen);
ReleaseDC(Handle, Canvas.Handle);
end;
procedure TFrmComInfo.FillFeatureData(TableName: String);
begin
EditLayer.KeyField := 'ID';
if DM.ADOQueryAll.Locate('ID', infoFeature.KeyValue, [loCaseInsensitive]) then
begin
// 添加图元属性
LEditName.Text := DM.ADOQueryAll.FieldByName('Name').AsString;
CBoxType.Text := DM.ADOQueryAll.FieldByName('Type').AsString;
MemoIntroduction.Text := DM.ADOQueryAll.FieldByName('Introduction').AsString;
end;
end;
procedure TFrmComInfo.FormShow(Sender: TObject);
begin
Top := 522;
Left := 168;
Width := 464;
Height := 0;
OnShowing := True;
TimerInfo.Enabled := True;
ClearEdit(Self);
LEditName.SetFocus;
Self.Caption := InfoLayerName + '信息';
// 处理不同的图层的相应的窗体设置
if InfoLayerName = '公交站点' then
LabelInfo.Caption := '所经车次:' else
if InfoLayerName = '街道' then
LabelInfo.Caption := '简介:' else
if InfoLayerName = '居民区' then
LabelInfo.Caption := '简介:' else
if InfoLayerName = '绿地' then
LabelInfo.Caption := '简介:' else
if InfoLayerName = '水系' then
LabelInfo.Caption := '简介:' else
if InfoLayerName = '地理区域' then
LabelInfo.Caption := '简介:';
OpenADOQueryAll(DM.ADOQueryAll, InfoLayerName);
if Not DM.ADOQueryText.Locate('ID', PYConvert(infoFeature.KeyValue), [loCaseInsensitive]) then
infFormViewType := NEW_FEATURE;
case infFormViewType of
NEW_FEATURE:
begin
IniNewFormData(Self);
end;
SELECT_FEATURE:
begin
IniSelectFormData(Self);
// 添图元对应的数据
FillFeatureData(EditLayer.Name);
end;
SEARCH_FEATURE:
begin
IniSearchFormData(Self);
FillFeatureData(EditLayer.Name);
end;
end;
// 记录原始图元名称
IniFeatureName := LEditName.Text;
end;
procedure TFrmComInfo.TimerInfoTimer(Sender: TObject);
begin
if OnShowing then
begin
Top := Top - 5;
Height := Height + 5;
if Height > 110 then TimerInfo.Enabled := False;
end
else
begin
Top := Top + 5;
Height := Height - 5;
if Height < 30 then
begin
TimerInfo.Enabled := False;
Close;
end;
end;
end;
procedure TFrmComInfo.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if Height > 30 then
begin
CanClose := False;
OnShowing := False;
TimerInfo.Enabled := True;
end;
end;
procedure TFrmComInfo.BBtnEditClick(Sender: TObject);
begin
EditBtnClick(Self);
end;
procedure TFrmComInfo.FillData();
begin
// 修改图元属性
DM.ADOQueryAll.FieldByName('ID').AsString := PYConvert(LEditName.Text);
DM.ADOQueryAll.FieldByName('Name').AsString := LEditName.Text;
DM.ADOQueryAll.FieldByName('Type').AsString := CBoxType.Text;
DM.ADOQueryAll.FieldByName('Introduction').AsString := MemoIntroduction.Text;
DM.ADOQueryAll.Post;
// 修改标记属性
DM.ADOQueryTextID.Value := PYConvert(LEditName.Text);
DM.ADOQueryTextName.Value := LEditName.Text;
DM.ADOQueryTextType.Value := CBoxType.Text;
DM.ADOQueryText.Post;
// 处理选择图元及对应的标注属性
SetFeatureAndLabel(IniFeatureName, LEditName.Text);
end;
procedure TFrmComInfo.BBtnExportClick(Sender: TObject);
begin
if LEditName.Text = '' then
begin
Application.MessageBox('记录名称不能为空,请输入名称!', '提示', 0);
LEditName.SetFocus;
end else
begin
case infFormViewType of
NEW_FEATURE:
begin
if Not DM.ADOQueryText.Locate('ID', PYConvert(LEditName.Text), [loCaseInsensitive]) then
begin
DM.ADOQueryAll.Append;
DM.ADOQueryText.Append;
FillData();
Close;
end else
begin
Application.MessageBox('记录已经存在,请重新输入登记信息!', '提示', 0);
LEditName.SetFocus;
end;
end;
SELECT_FEATURE:
begin
if (DM.ADOQueryText.Locate('ID', PYConvert(LEditName.Text), [loCaseInsensitive]))
and (IniFeatureName <> LEditName.Text)
then
begin
Application.MessageBox('记录已经存在,请重新输入修改信息!', '提示', 0);
LEditName.SetFocus;
end else
begin
DM.ADOQueryAll.Locate('ID', PYConvert(IniFeatureName), [loCaseInsensitive]);
DM.ADOQueryAll.Edit;
DM.ADOQueryText.Locate('ID', PYConvert(IniFeatureName), [loCaseInsensitive]);
DM.ADOQueryText.Edit;
FillData();
Close;
end;
end;
end;
end;
end;
procedure TFrmComInfo.BBtnDeleteClick(Sender: TObject);
begin
// 删除图元及对应的数据 标记图元及数据
if Application.MessageBox('确实要删除吗?', '提示', MB_YESNO) = IDYES then
DeleteFeatureLabelData(PYConvert(IniFeatureName));
Close;
end;
procedure TFrmComInfo.FormClose(Sender: TObject; var Action: TCloseAction);
begin
FrmSearchResult.TimerFlash.Enabled := False;
if FrmMain.Map1.GeoSet <> '' then
FrmMain.Map1.Layers.ClearSelection;
end;
procedure TFrmComInfo.BBtnCancelClick(Sender: TObject);
begin
// if InfoLayerName = '公交站点' then
// begin
// // 符号的类型
// case infFormViewType of
// NEW_FEATURE: EditLayer.DeleteFeature(infoFeature);
// end;
// end;
Close;
end;
procedure TFrmComInfo.CBoxTypeChange(Sender: TObject);
begin
// 设置标注文字的属性
SetLabelStyle(CBoxType.Text);
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -