mainfrm.pas

Delphi + MapX程序框架(地图)源码程序

unit MainFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxGraphics, ExtCtrls, dxDockControl, dxDockPanel, cxControls,
  dxStatusBar, Menus, dxBar, ImgList, ComCtrls, ToolWin, Global, MapFrm,
  ActnList, OleCtrls, MapX, StdCtrls, CheckLst, cxPC;

type
  TfrmMain = class(TForm)
    pnlLayers: TdxDockPanel;
    dxDockSite1: TdxDockSite;
    pnlHawk: TdxDockPanel;
    dxLayoutDockSite1: TdxLayoutDockSite;
    dxVertContainerDockSite1: TdxVertContainerDockSite;
    pnlEvaScheme: TdxDockPanel;
    dxTabContainerDockSite1: TdxTabContainerDockSite;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    btnOpenMap: TMenuItem;
    ImageList1: TImageList;
    N2: TMenuItem;
    btnNew: TMenuItem;
    dxDockingManager1: TdxDockingManager;
    ControlBar1: TControlBar;
    ToolBar1: TToolBar;
    btnToolNew: TToolButton;
    btnToolOpen: TToolButton;
    ActionList1: TActionList;
    trvEvaScheme: TTreeView;
    btnOpenEvaScheme: TMenuItem;
    Panel1: TPanel;
    clbLayers: TCheckListBox;
    tlbMapTool: TToolBar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ZoomInTool: TAction;
    ZoomOutTool: TAction;
    PanTool: TAction;
    OpenDialog1: TOpenDialog;
    OpenFile: TAction;
    NewFile: TAction;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    ToolButton7: TToolButton;
    ToolButton8: TToolButton;
    ToolButton9: TToolButton;
    PointSelectTool: TAction;
    SaveFile: TAction;
    RadiusSelectTool: TAction;
    RectSelectTool: TAction;
    RulerTool: TAction;
    AreaTool: TAction;
    LabelTool: TAction;
    InforTool: TAction;
    ToolButton10: TToolButton;
    PolygonSelectTool: TAction;
    ToolButton11: TToolButton;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    ViewLayers: TAction;
    ViewScheme: TAction;
    ViewHawkMap: TAction;
    ToolButton12: TToolButton;
    ToolButton13: TToolButton;
    TitleSetting: TAction;
    ToolButton14: TToolButton;
    LayerSetting: TAction;
    ToolButton15: TToolButton;
    ToolButton16: TToolButton;
    ToolButton17: TToolButton;
    SaveGraph: TAction;
    ToolButton18: TToolButton;
    PrintMap: TAction;
    ToolButton19: TToolButton;
    ThemeSetting: TAction;
    cxTabControl1: TcxTabControl;
    dxStatusBar1: TdxStatusBar;
    dxStatusBar1Container2: TdxStatusBarContainerControl;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    N15: TMenuItem;
    TaskConfig: TAction;
    ToolButton20: TToolButton;
    ToolButton21: TToolButton;
    SearchSetting: TAction;
    ToolButton22: TToolButton;
    ToolButton23: TToolButton;
    ToolButton24: TToolButton;
    FAnalyseSetting: TAction;
    LAnalyseSetting: TAction;
    PAnalyseSetting: TAction;
    RAnalyseSetting: TAction;
    procedure ViewHawkMapExecute(Sender: TObject);
    procedure ViewSchemeExecute(Sender: TObject);
    procedure ViewLayersExecute(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure clbLayersClickCheck(Sender: TObject);
    procedure clbLayersClick(Sender: TObject);
    procedure ZoomInToolExecute(Sender: TObject);
    procedure ZoomOutToolExecute(Sender: TObject);
    procedure PanToolExecute(Sender: TObject);
    procedure OpenFileExecute(Sender: TObject);
    procedure NewFileExecute(Sender: TObject);
    procedure PointSelectToolExecute(Sender: TObject);
    procedure RadiusSelectToolExecute(Sender: TObject);
    procedure RectSelectToolExecute(Sender: TObject);
    procedure RulerToolExecute(Sender: TObject);
    procedure AreaToolExecute(Sender: TObject);
    procedure LabelToolExecute(Sender: TObject);
    procedure InforToolExecute(Sender: TObject);
    procedure PolygonSelectToolExecute(Sender: TObject);
    procedure ActionList1Update(Action: TBasicAction;
      var Handled: Boolean);
    procedure TitleSettingExecute(Sender: TObject);
    procedure LayerSettingExecute(Sender: TObject);
    procedure SaveFileExecute(Sender: TObject);
    procedure SaveGraphExecute(Sender: TObject);
    procedure PrintMapExecute(Sender: TObject);
    procedure ThemeSettingExecute(Sender: TObject);
    procedure cxTabControl1Change(Sender: TObject);
    procedure TaskConfigExecute(Sender: TObject);
    procedure SearchSettingExecute(Sender: TObject);
    procedure FAnalyseSettingExecute(Sender: TObject);
    procedure LAnalyseSettingExecute(Sender: TObject);
    procedure PAnalyseSettingExecute(Sender: TObject);
    procedure RAnalyseSettingExecute(Sender: TObject);
  private
    { Private declarations }
    FHawkMap: THawkMap;
    function GetChildFormFromFileName(AFileName: string): TfrmMap;
    function CreateChildForm(AFileName: string): TfrmMap;
  protected
   
  public
    { Public declarations }
    //显示地图文件，返回显示的子窗体
    function ShowMapFile(AFileName: string; AForm: TfrmMap): TfrmMap;

    //打开评价方案
    procedure OpenEvaScheme(AFileName: string);
    procedure ResetHawkMap(FileName: string);
    procedure ResetLayers(Layers: TStringList; VisibleLayers: TStringList);
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject);
begin
  FHawkMap:= THawkMap.Create(Panel1);
end;

procedure TfrmMain.FormDestroy(Sender: TObject);
begin
  FHawkMap.Free;
end;

procedure TfrmMain.FormShow(Sender: TObject);
begin
  //
end;

procedure TfrmMain.OpenEvaScheme(AFileName: string);
begin

end;

function TfrmMain.CreateChildForm(AFileName: string): TfrmMap;
begin
  Result := TfrmMap.Create(Application);
  Result.Caption := AFileName;
  if (AFileName = '') or (FileExists(AFileName)) then
    Result.OpenMapFile(AFileName);
  cxTabControl1.Tabs.AddObject(ExtractFileName(Result.Caption), Result);
  cxTabControl1.TabIndex:= cxTabControl1.Tabs.Count-1;
end;

function TfrmMain.GetChildFormFromFileName(AFileName: string): TfrmMap;
var
  I: Integer;
  sTransformedName, sTransformedResultName: String;
begin
  I:= 0;
  Result:= nil;
  while I < MDIChildCount do
  begin
    Result := TfrmMap(MDIChildren[I]);
    if Result.FileName = AFileName then  Break
    else Result:= nil;
    Inc(I);
  end;
end;

function TfrmMain.ShowMapFile(AFileName: string; AForm: TfrmMap): TfrmMap;
var
  Wnd: HWnd;
  List1,List2: TStringList;
begin
  if AForm = nil then
    Result:= GetChildFormFromFileName(AFileName)
  else Result:= AForm;
  if Result <> nil then
  begin
    if Result <> ActiveMDIChild then
    begin
      Wnd:= GetWindow(Result.Handle, GW_HWNDNEXT);
      SendMessage(ClientHandle, WM_MDINEXT, wnd, 1);
    end
  end
  else begin
     Result := CreateChildForm(AFileName);
  end;
  if (AFileName = '') or (FileExists(AFileName)) then
  begin
    List1:= TStringList.Create;
    List2:= TStringList.Create;
    ResetHawkMap(AFileName);
    FHawkMap.SetBuddyMap(Result.MyMap);
    Result.MyMap.Get_Layers(List1);
    Result.MyMap.Get_VisibleLayers(List2);
    ResetLayers(List1, List2);
    List1.Free;
    List2.Free;
  end;
end;

procedure TfrmMain.cxTabControl1Change(Sender: TObject);
var
  AForm: TfrmMap;
begin
  if ([csDestroying] * ComponentState <> []) then Exit;
  SendMessage(ClientHandle, WM_MDIREFRESHMENU, 0, 0);
  if cxTabControl1.TabIndex > -1 then
  begin