📄 unitmain.pas
字号:
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, OleCtrls, MapXLib_TLB, StdCtrls, ExtCtrls, ComCtrls, ComObj,
ToolWin, ImgList, Buttons, Registry, DB, Mask, IdGlobal, ShellAPI;
const
IDI_TRAYICON=WM_USER + 10;
TRAY_CALLBACK=WM_USER + 20;
type
TFrmMain = class(TForm)
MainMenu1: TMainMenu;
NSystemManage: TMenuItem;
NMapControl: TMenuItem;
NmiPanTool: TMenuItem;
NCUSTOM_ZOOMIN_TOOL: TMenuItem;
NCUSTOM_ZOOMOUT_TOOL: TMenuItem;
NCUSTOM_SYMBOL_TOOL: TMenuItem;
NCUSTOM_TEXT_TOOL: TMenuItem;
NmiSelectTool: TMenuItem;
NmiRadiusSelectTool: TMenuItem;
NmiRectSelectTool: TMenuItem;
NmiPolygonSelectTool: TMenuItem;
NCUSTOM_LINE_TOOL: TMenuItem;
NCUSTOM_POLYLINE_TOOL: TMenuItem;
NCUSTOM_REGION_TOOL: TMenuItem;
SBar: TStatusBar;
PanelBack: TPanel;
NUserManage: TMenuItem;
NDataBaseManage: TMenuItem;
NClientManage: TMenuItem;
NRecordManage: TMenuItem;
NReEnter: TMenuItem;
NExit: TMenuItem;
NModifyWindows: TMenuItem;
NCSCommunicate: TMenuItem;
NView: TMenuItem;
NToolBar: TMenuItem;
NSearchWindows: TMenuItem;
NStatusBar: TMenuItem;
NHelp: TMenuItem;
NMainHelp: TMenuItem;
NAboutSystem: TMenuItem;
NAboutAuthor: TMenuItem;
PanelClient: TPanel;
Map1: TMap;
ImageList1: TImageList;
NMapViewTool: TMenuItem;
NIniMap: TMenuItem;
NDrawMapTool: TMenuItem;
NLayerManage: TMenuItem;
NLoadGST: TMenuItem;
NSelectMapTool: TMenuItem;
NRemoveFeature: TMenuItem;
NViewBeforeMap: TMenuItem;
N2: TMenuItem;
NEagleEye: TMenuItem;
NUpLoadGST: TMenuItem;
NCUSTOM_CIRCULARREGION_TOOL: TMenuItem;
NmiCenterTool: TMenuItem;
NNavigation: TMenuItem;
N3: TMenuItem;
NCombineFeature: TMenuItem;
NCUSTOM_RECTANGLE_TOOL: TMenuItem;
CoolBar1: TCoolBar;
ToolBarMapViewTool: TToolBar;
TBtnmiPanTool: TToolButton;
TBtnCUSTOM_ZOOMIN_TOOL: TToolButton;
TBtnCUSTOM_ZOOMOUT_TOOL: TToolButton;
TBtnmiCenterTool: TToolButton;
ToolButton1: TToolButton;
TBtnEagleEye: TToolButton;
TBtnNavigation: TToolButton;
TBtnViewBeforeMap: TToolButton;
TBtnIniMap: TToolButton;
ToolBarDrawMapTool: TToolBar;
TBtnCUSTOM_SYMBOL_TOOL: TToolButton;
TBtnCUSTOM_TEXT_TOOL: TToolButton;
TBtnCUSTOM_LINE_TOOL: TToolButton;
TBtnCUSTOM_POLYLINE_TOOL: TToolButton;
TBtnCUSTOM_RECTANGLE_TOOL: TToolButton;
TBtnCUSTOM_CIRCULARREGION_TOOL: TToolButton;
TBtnCUSTOM_REGION_TOOL: TToolButton;
TBtnRemoveFeature: TToolButton;
TBtnCombineFeature: TToolButton;
ToolButton12: TToolButton;
NmiClearSelTool: TMenuItem;
NDrawStyleModify: TMenuItem;
TBtnmiSelectTool: TToolButton;
TBtnmiRadiusSelectTool: TToolButton;
TBtnmiRectSelectTool: TToolButton;
TBtnmiPolygonSelectTool: TToolButton;
BtnClearSelTool: TToolButton;
ToolButton4: TToolButton;
TBtnLayerManage: TToolButton;
ToolButton2: TToolButton;
TimerModifyMoveText: TTimer;
TBtnCUSTOM_LABEL_TOOL: TToolButton;
NCUSTOM_LABEL_TOOL: TMenuItem;
NPackMap: TMenuItem;
NInfoManage: TMenuItem;
PMenuRight: TPopupMenu;
PNmiPanTool: TMenuItem;
PNCUSTOM_ZOOMIN_TOOL: TMenuItem;
PNCUSTOM_ZOOMOUT_TOOL: TMenuItem;
PNmiCenterTool: TMenuItem;
N8: TMenuItem;
PNEagleEye: TMenuItem;
PNNavigation: TMenuItem;
PNViewBeforeMap: TMenuItem;
PNAllMap: TMenuItem;
PNIniMap: TMenuItem;
N14: TMenuItem;
N15: TMenuItem;
NAllMap: TMenuItem;
TBtnAllMap: TToolButton;
PMenuIcon: TPopupMenu;
PNExit: TMenuItem;
Timer: TTimer;
N11: TMenuItem;
NMapTool: TMenuItem;
N21: TMenuItem;
TBtnLoadGS: TToolButton;
TBtnUpLoadGST: TToolButton;
TBtnPackMap: TToolButton;
ToolButton5: TToolButton;
TBtnDrawStyleModify: TToolButton;
procedure NLayerManageClick(Sender: TObject);
procedure NLoadGSTClick(Sender: TObject);
procedure Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
var EnableDefault: WordBool);
procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
Y2, Distance: Double; Shift, Ctrl: WordBool;
var EnableDefault: WordBool);
procedure NRemoveFeatureClick(Sender: TObject);
procedure Map1MapViewChanged(Sender: TObject);
procedure NViewBeforeMapClick(Sender: TObject);
procedure NIniMapClick(Sender: TObject);
procedure NUpLoadGSTClick(Sender: TObject);
procedure NSearchWindowsClick(Sender: TObject);
procedure NmiPanToolClick(Sender: TObject);
procedure NCUSTOM_ZOOMIN_TOOLClick(Sender: TObject);
procedure NCUSTOM_ZOOMOUT_TOOLClick(Sender: TObject);
procedure NmiCenterToolClick(Sender: TObject);
procedure NEagleEyeClick(Sender: TObject);
procedure NNavigationClick(Sender: TObject);
procedure NCombineFeatureClick(Sender: TObject);
procedure NCUSTOM_SYMBOL_TOOLClick(Sender: TObject);
procedure NCUSTOM_TEXT_TOOLClick(Sender: TObject);
procedure NCUSTOM_LINE_TOOLClick(Sender: TObject);
procedure NCUSTOM_POLYLINE_TOOLClick(Sender: TObject);
procedure NCUSTOM_RECTANGLE_TOOLClick(Sender: TObject);
procedure NCUSTOM_CIRCULARREGION_TOOLClick(Sender: TObject);
procedure NCUSTOM_REGION_TOOLClick(Sender: TObject);
procedure NmiSelectToolClick(Sender: TObject);
procedure NmiRadiusSelectToolClick(Sender: TObject);
procedure NmiRectSelectToolClick(Sender: TObject);
procedure NmiPolygonSelectToolClick(Sender: TObject);
procedure NmiClearSelToolClick(Sender: TObject);
procedure NDrawStyleModifyClick(Sender: TObject);
procedure Map1DblClick(Sender: TObject);
procedure NModifyWindowsClick(Sender: TObject);
procedure Map1Click(Sender: TObject);
procedure TimerModifyMoveTextTimer(Sender: TObject);
procedure Map1MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Map1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure NCUSTOM_LABEL_TOOLClick(Sender: TObject);
procedure Map1SelectionChanged(Sender: TObject);
procedure NPackMapClick(Sender: TObject);
procedure Map1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure Map1KeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure NAboutSystemClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure NAllMapClick(Sender: TObject);
procedure PNExitClick(Sender: TObject);
procedure AppException(Sender: TObject; E: Exception);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure TrayCallBack(var Msg:TMessage); message TRAY_CALLBACK;
procedure NReEnterClick(Sender: TObject);
procedure TimerTimer(Sender: TObject);
procedure NClientManageClick(Sender: TObject);
procedure NRecordManageClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure NExitClick(Sender: TObject);
procedure NToolBarClick(Sender: TObject);
procedure NStatusBarClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
FrmMain: TFrmMain;
implementation
uses UnitLayerControl, UnitCompanys, UnitLabelInfo, UnitCommonModule,
UnitSearch, UnitNavigation, UnitDrawStyleModify, UnitModify,
UnitDataModule, UnitComInfo, UnitComWay, UnitAbout, UnitSplash, UnitEagleEye, UnitLogin,
UnitClientManage, UnitRecordManage;
{$R *.dfm}
procedure TFrmMain.NLayerManageClick(Sender: TObject);
begin
if FrmLayerControl = Nil then
Application.CreateForm(TFrmLayerControl, FrmLayerControl);
FrmLayerControl.ShowModal;
end;
procedure TFrmMain.NLoadGSTClick(Sender: TObject);
begin
// Load Map1 GeoSet
LoadMapSetIniMap();
end;
procedure TFrmMain.Map1PolyToolUsed(Sender: TObject; ToolNum: Smallint;
Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
var EnableDefault: WordBool);
begin
If Not (EditLayer.Type_ = miLayerTypeUserDraw) Then
If Flags = miPolyToolBegin Then
//Someone's beginning the use of a PolyTool...
Else
If Flags = miPolyToolEnd Then
begin
// 添加随机的数据信息
AddRandomData();
Case ToolNum of
CUSTOM_REGION_TOOL :
begin
newObj := Map1.FeatureFactory.CreateRegion(Points, Map1.DefaultStyle);
end;
CUSTOM_POLYLINE_TOOL :
begin
newObj := Map1.FeatureFactory.CreateLine(Points, Map1.DefaultStyle);
end;
end;
EditLayer.AddFeature(newobj, RowVals);
end
Else If Flags = miPolyToolEndEscaped then
begin
// The users hit 'Esc' or backspaced all the nodes
// away... don't add anything in.
end;
end;
procedure TFrmMain.Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1,
X2, Y2, Distance: Double; Shift, Ctrl: WordBool;
var EnableDefault: WordBool);
var
pts: Variant; // Used for storing collection of points
temZoom: Double;
begin
infFormViewType := NEW_FEATURE;
Pt := CreateOleObject('MapX.Point.5');
Pt.Set(X1, Y1);
Case ToolNum of
CUSTOM_ZOOMIN_TOOL :
begin
if (X1 = X2) or (Y1 = Y2) then
begin
if (Map1.Zoom/1.8 > MINZOOM) then Map1.ZoomTo(Map1.Zoom/1.8, X1, Y1)
else Map1.ZoomTo(MINZOOM, X1, Y1)
end else
begin
if Map1.Width/Abs(X2 - X1) > Map1.Height/Abs(Y2 - Y1)
then temZoom := Map1.Bounds.Height/Abs(Y2 - Y1)
else temZoom := Map1.Bounds.Width/Abs(X2 - X1);
if (Map1.Zoom/temZoom > MINZOOM)
then Map1.ZoomTo(Map1.Zoom/temZoom, (X1+X2)/2, (Y1+Y2)/2)
else Map1.ZoomTo(MINZOOM, (X1+X2)/2, (Y1+Y2)/2)
end;
SetViewLayer();
end;
CUSTOM_ZOOMOUT_TOOL :
begin
if (X1 = X2) or (Y1 = Y2) then
begin
if (Map1.Zoom*1.8 < MAXZOOM) then Map1.ZoomTo(Map1.Zoom*1.8, X1, Y1)
else Map1.ZoomTo(MAXZOOM, X1, Y1)
end else
begin
if Map1.Width/Abs(X2 - X1) > Map1.Height/Abs(Y2 - Y1)
then temZoom := Map1.Bounds.Height/Abs(Y2 - Y1)
else temZoom := Map1.Bounds.Width/Abs(X2 - X1);
if (Map1.Zoom*temZoom < MAXZOOM)
then Map1.ZoomTo(Map1.Zoom*temZoom, (X1+X2)/2, (Y1+Y2)/2)
else Map1.ZoomTo(MAXZOOM, (X1+X2)/2, (Y1+Y2)/2)
end;
SetViewLayer();
end;
CUSTOM_SYMBOL_TOOL :
begin
newObj := Map1.FeatureFactory.CreateSymbol(Pt, Map1.DefaultStyle);
EditLayer.AddFeature(newObj, Empty);
Ftrs := EditLayer.SearchAtPoint(Pt, 0);
if Ftrs.Count = 1 Then
begin
infoFeature := Ftrs.Item[1];
if FrmModify.CBoxEditLayerName.Text = '企事业' then FrmCompanysInfo.ShowModal;
if FrmModify.CBoxEditLayerName.Text = '公交站点' then FrmComInfo.ShowModal;
end;
end;
CUSTOM_LINE_TOOL :
begin
if Not((X1 = X2) and (Y1 = Y2)) then
begin
pts := CreateOleObject('MapX.Points.5');
pts.AddXY(X1, Y1);
pts.AddXY(X2, Y2);
// 添加随机的数据信息
AddRandomData();
// 添加图元
newObj := Map1.FeatureFactory.CreateLine(pts, Map1.DefaultStyle);
EditLayer.AddFeature(newObj, RowVals);
VarClear(pts);
end;
end;
CUSTOM_CIRCULARREGION_TOOL :
begin
// 添加随机的数据信息
AddRandomData();
newObj := Map1.FeatureFactory.CreateCircularRegion(miCircleTypeMap, Pt, Distance, miUnitMile, Empty, Map1.DefaultStyle);
EditLayer.AddFeature(newObj, RowVals);
end;
CUSTOM_RECTANGLE_TOOL :
begin
pts := CreateOleObject('MapX.Points.5');
pts.AddXy(X1, Y1); pts.AddXy(X2, Y1);
pts.AddXy(X2, Y2); pts.AddXy(X1, Y2);
// 添加随机的数据信息
AddRandomData();
newObj := Map1.FeatureFactory.CreateRegion(Pts, Map1.DefaultStyle);
EditLayer.AddFeature(newobj, RowVals);
VarClear(pts);
end;
CUSTOM_TEXT_TOOL :
begin
FrmLabelInfo.ShowModal;
end;
CUSTOM_LABEL_TOOL :
begin
LabelToolUsed();
end;
miSelectTool, miRadiusSelectTool,
miRectSelectTool, miPolygonSelectTool :
begin
if (Ctrl) then
EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionAppend, Empty)
else if (Shift) then
EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionRemove, Empty)
else
EditLayer.Selection.SelectByPoint(X1, Y1, miSelectionNew, Empty);
end;
CUSTOM_INFO_TOOL :
begin
Ftrs := EditLayer.SearchAtPoint(Pt, 0);
if Ftrs.Count = 1 Then
begin
infFormViewType := SEARCH_FEATURE;
infoFeature := Ftrs.Item[1];
// 根据类型选择窗体了
end;
end;
end;
// 释放Pt
Varclear(Pt);
end;
procedure TFrmMain.NRemoveFeatureClick(Sender: TObject);
var
i: Integer;
begin
if EditLayer.Selection.Count > 0 then
if Application.MessageBox('确实要删除吗?', '提示', MB_YESNO) = IDYES then
begin
try
// 删除图元及对应的数据 标记图元及数据
for i := 1 to EditLayer.Selection.Count do
begin
DeleteNumI := i;
EditLayer.KeyField := 'ID';
DeleteFeatureLabelData(EditLayer.Selection.Item[i].KeyValue);
end;
EditLayer.Selection.ClearSelection;
Except on E:Exception do ShowMessage(E.message);
end;
end else EditLayer.Selection.ClearSelection;
end;
procedure TFrmMain.Map1MapViewChanged(Sender: TObject);
begin
SetMapViewChanged();
end;
procedure TFrmMain.NViewBeforeMapClick(Sender: TObject);
begin
Map1.ZoomTo(PrevMapZoom, PrevMapZoomPosX, PrevMapZoomPosY);
SetViewLayer();
end;
procedure TFrmMain.NIniMapClick(Sender: TObject);
begin
Map1.ZoomTo(IniMapZoom, IniMapZoomPosX, IniMapZoomPosY);
SetViewLayer();
end;
procedure TFrmMain.NUpLoadGSTClick(Sender: TObject);
begin
if Map1.Layers.Count=0 then ShowMessage('地图至少需要一个图层,请添加图层!')
else Map1.SaveMapAsGeoset('JLU-MAP', ExeFilePath+'Maps\JLU-MAP.GST');
UpLoadMap();
end;
procedure TFrmMain.NSearchWindowsClick(Sender: TObject);
begin
FrmSearch.Show;
end;
procedure TFrmMain.NmiPanToolClick(Sender: TObject);
begin
Map1.CurrentTool := miPanTool;
Set_MenuCheck_BtnDown(NmiPanTool, TBtnmiPanTool);
end;
procedure TFrmMain.NCUSTOM_ZOOMIN_TOOLClick(Sender: TObject);
begin
Map1.CurrentTool := CUSTOM_ZOOMIN_TOOL;
Set_MenuCheck_BtnDown(NCUSTOM_ZOOMIN_TOOL, TBtnCUSTOM_ZOOMIN_TOOL);
end;
procedure TFrmMain.NCUSTOM_ZOOMOUT_TOOLClick(Sender: TObject);
begin
Map1.CurrentTool := CUSTOM_ZOOMOUT_TOOL;
Set_MenuCheck_BtnDown(NCUSTOM_ZOOMOUT_TOOL, TBtnCUSTOM_ZOOMOUT_TOOL);
end;
procedure TFrmMain.NmiCenterToolClick(Sender: TObject);
begin
Map1.CurrentTool := miCenterTool;
Set_MenuCheck_BtnDown(NmiCenterTool, TBtnmiCenterTool);
end;
procedure TFrmMain.NEagleEyeClick(Sender: TObject);
begin
NEagleEye.Checked := Not NEagleEye.Checked;
PNEagleEye.Checked := NEagleEye.Checked;
TBtnEagleEye.Down := NEagleEye.Checked;
FrmEagleEye.Visible := NEagleEye.Checked;
end;
procedure TFrmMain.NNavigationClick(Sender: TObject);
begin
NNavigation.Checked := Not NNavigation.Checked;
PNNavigation.Checked := NNavigation.Checked;
TBtnNavigation.Down := NNavigation.Checked;
FrmNavigation.Visible := NNavigation.Checked;
end;
procedure TFrmMain.NCombineFeatureClick(Sender: TObject);
Var
selItems : Variant;
newFeature, Style: Variant;
i: Integer;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -