?? mapx.~pas

?? Delphi + MapX程序框架(地圖)源碼程序
?? ~PAS
?? 第 1 頁 / 共 3 頁
字號:
12 3 下一頁
unit MapX;

interface

uses MapXLib_TLB, Classes, Controls, Dialogs, SysUtils, Forms, Variants, Printers,
  RulerFrm, AreaFrm, InforFrm, Graphics, Messages, CommCtrl, Windows;

type
  TMapX = class;

  TMapXToolType = (
    mttPointSelectTool=100, mttRadiusSelectTool=101, mttRectSelectTool=102,
    mttPolygonSelectTool=103, mttMultiRadiusSelectTool=104, mttMultiRectSelectTool=105,
    mttMultiPolygonSelectTool=106, mttInforTool=107, mttRulerTool=108, mttAreaTool=109,
    mttLabelTool=110,
    mttArrowTool=1000, mttPanTool=1001, mttZoomInTool=1003, mttZoomOutTool=1004
    );

  //所有工具的基類
  TMapXToolObject = class
  private
    FMapX: TMapX;
    FToolType: TMapXToolType;
  public
    constructor Create(const Sender: TMapX); virtual;
    //執行工具
    procedure Execute; virtual; abstract;
  end;

  //所有選擇工具的基類，在Execute方法中判斷圖層是否可選擇
  TMapXSelectToolObject = class(TMapXToolObject)
  private
    //能否被使用
    FEnable: Boolean;
    //選擇對象結果,由具體的工具實現
    FSelection: CMapxFeatures;
  public
    procedure Execute; override;
  end;

  //所有跟點選有關工具的基類，在Execute方法中獲得選擇對象
  TMapXPointSelectToolObject = class(TMapXSelectToolObject)
  public
    procedure Execute(X1, Y1: Double); overload; virtual;
  end;

  //點選擇工具
  TPointSelectTool = class(TMapXPointSelectToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(X1, Y1: Double; Shift, Ctrl: WordBool); overload;
  end;

  //圓選擇工具
  TRadiusSelectTool = class(TMapXSelectToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(X1, Y1, Distance: Double; Shift, Ctrl: WordBool); overload;
  end;

  //矩形選擇工具
  TRectSelectTool = class(TMapXSelectToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(X1, Y1, X2, Y2: Double; Shift, Ctrl: WordBool); overload;
  end;

  //多邊形選擇工具
  TPolygonSelectTool = class(TMapXSelectToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(const Points: IDispatch; Shift, Ctrl: WordBool); overload;
  end;

  TRulerMode = (rmFinished,rmProcessing);
  TMouseMode = (mmDown,mmMove);
  //距離丈量工具
  TRulerTool = class(TMapXToolObject)
  private
    FfrmRuler: TfrmRuler;
    FXDown, FYDown: Double;    //記錄鼠標按下的地圖坐標
    FXMove, FYMove: Double;    //記錄鼠標移到的地圖坐標
    FRulerMode : TRulerMode;     //記錄標尺的模式是處于進行狀態還是完成狀態
    FRuleCurrDistance: Double;   //記錄當前兩點之間的距離
    FRulePastDistance: Double;  //記錄已經經過的距離距離
  public
    constructor Create(const Sender: TMapX); override;
    destructor Destroy; override;
    procedure Execute(X, Y: Integer; Button: TMouseButton; Mode: TMouseMode); overload;
  end;

  //面積丈量工具
  TAreaTool = class(TMapXToolObject)
  private
    FGirth: Double;   //多邊行：周長-首尾點長度
    FArea: Double;
    FfrmArea: TfrmArea;
  public
    constructor Create(const Sender: TMapX); override;
    destructor Destroy; override;
    procedure Execute(const Points: IDispatch); overload;
  end;

  //對象信息顯示工具
  TInforTool = class(TMapXPointSelectToolObject)
  private
    FfrmInfor: TfrmInfor;
  public
    constructor Create(const Sender: TMapX); override;
    destructor Destroy; override;
    procedure Execute(X1, Y1: Double); override;
  end;
  
  //對象標注工具
  TLabelTool = class(TMapXPointSelectToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(X1, Y1: Double); override;
  end;

  { 所有地圖編輯工具的基類 
  TEditToolObject = class(TToolObject)
  private
    FEditable: Boolean;
    FTimer: TTimer;
  public
    constructor Create(const Sender: TMapX); override;
    procedure Activate; override;
    procedure OnTimer(Sender: TObject); virtual; abstract;
    destructor Destroy; override;
    //當前圖層是否可編輯，在改變當前圖層時獲得
    //  詳見MapXCurrentLyrChanged函數
    property Editable: Boolean read FEditable write FEditable;
    property Timer: TTimer read FTimer write FTimer;
  end;
  }
  { 增加點對象工具 
  TAddPointTool = class(TEditToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(X1, Y1: Double); overload;
  end;
  }
  { 增加多邊線工具 
  TAddPolyLineTool = class(TEditToolObject)
  private
    procedure OnTimer(Sender: TObject); override;
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(const Points: IDispatch); overload;
  end;
  }
  { 增加多邊形工具 
  TAddPolygonTool = class(TEditToolObject)
  public
    constructor Create(const Sender: TMapX); override;
    procedure Execute(const Points: IDispatch); overload;
  end;
  }
  TMapXThemeType = (mttRanged, mttBar, mttPie, mttGradSymbol, mttDotDensity,
    mttIndividualValue);
  //專題圖
  TMapXTheme = class(TObject)
  private
    FMapX: TMapX;
    FName: string;
    //地圖上的對象ID集合
    FFeatureIDList: TStringList;
    //數據庫表名
    FDBTableName: string;
    //表中索引字段名
    FIDFieldName: string;
    //表中數據字段名
    FDataFieldName: string;
    //專題圖類型
    FThemeType: TMapXThemeType;
  public
    constructor Create(const Sender: TMapX); virtual;
    destructor Destroy; override;
    procedure LoadFromStream(AStream: TStream);
    procedure SaveToStream(var Stream);
    procedure CreateLayerTheme(ALayer: string; FeatureIDs: TStringList = nil);
    property MapX: TMapX read FMapX;
  end;

  { 按Tab表字段搜索對象的種類:
    stExact:        精確匹配
    stLeftDim:      從左邊起匹配
    stRightDim:     從右邊起匹配
    stArbitraryDim: 任意匹配
    獲取搜索結果函數: GetSearchResult}
  TSearchType = (stExact, stLeftDim, stRightDim, stArbitraryDim);

  { 對象空間位置分析的種類:
     atSelected:    顯示當前土層的選擇對象結果
     atAlongLine:   顯示沿線周邊緩沖區內的對象結果
     atInRegion:    顯示某區域內的對象結果
     atAroundPoint: 顯示某點周圍緩沖區內的對象結果
     獲取結果函數: GetAnalyseResult}
  TAnalyseType = (atSelected, atAlongLine, atInRegion, atAroundPoint);
  TAnalyseTypes = set of TAnalyseType;

  TWorkLayerChanged = procedure(Sender: TObject; NewWorkLayer: string) of object;
  TCurrentToolChanged = procedure(Sender: TObject; NewTool: TMapXToolType) of object;

  TMapX = class(TObject)
  private
    FMap: TMap;
    //地圖文件
    FFileName: string;
    //工作圖層
    FWorkLayer: string;
    //當前鼠標所處的地理坐標
    FMouseX,FMouseY: Double;
    //當前鼠標所處的屏幕坐標 }
    FMouseScreenX, FMouseScreenY: Integer;
    //當前鼠標位置下,"當前圖層"上的對象.根據鼠標的移動即時更新
    FFeatureUnderMouse: CMapXFeature;
    //當前工具
    FCurrentTool: TMapXToolType;
    //各種工具
    FPointSelectTool: TPointSelectTool;
    FRadiusSelectTool: TRadiusSelectTool;
    FRectSelectTool: TRectSelectTool;
    FPolygonSelectTool: TPolygonSelectTool;

    FInforTool: TInforTool;
    FRulerTool: TRulerTool;
    FAreaTool: TAreaTool;
    FLabelTool: TLabelTool;

    FOnWorkLayerChanged: TWorkLayerChanged;
    FOnCurrentToolChanged: TCurrentToolChanged;

    FMapXTheme: TMapXTheme;

    procedure SetFileName(const Value: string); virtual;
    procedure SetWorkLayer(const Value: string);
    procedure SetCurrentTool(const Value: TMapXToolType);
    function LayerExist(ALayer: string): Boolean;
    function LayerVisible(ALayer: string): Boolean;
    function LayerSelectable(ALayer: string): Boolean;
    function DataExist(AData: string): Boolean;
    function GetMapHandle: HWND;
  protected
    procedure MapXOnMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); virtual;
    procedure MapXOnMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer); virtual;
    procedure MapXOnMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer); virtual;
    procedure MapXOnToolUsed(ASender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool); virtual;
    procedure MapXOnPolyToolUsed(ASender: TObject; ToolNum: Smallint;
      Flags: Integer; const Points: IDispatch; bShift, bCtrl: WordBool;
      var EnableDefault: WordBool);  virtual;
  public
    constructor Create(AOwner: TComponent); overload; virtual;
    destructor Destroy; override;
    //打開地圖
    procedure OpenFile(AFileName: string); virtual;
    //獲取地圖的所有圖層名稱
    procedure Get_Layers(AList: TStringList);
    //獲取地圖的所有可視圖層名稱
    procedure Get_VisibleLayers(AList: TStringList);
    //獲取地圖的某一圖層的字段集合
    procedure Get_LayerFields(ALayer: string; AList: TStringList);
    //設置圖層的可視否
    procedure SetLayerVisible(ALayer: string; IsVisible: Boolean);
    //設置圖層的關鍵字段
    procedure SetLayerKeyField(ALayer, AField: string);
    //設置某個圖層的選擇結果
    //若Shift為true: 從圖層Lyr的已有選擇對象中去除Fs
    //若Ctrl為true: 從圖層Lyr的已有選擇對象中增加Fs
    //若Shift、Ctrl均為False：用Fs代替圖層Lyr的已有選擇對象
    procedure SetLayerSelection(Shift, Ctrl: boolean;
      Fs: CMapxFeatures; ALayer: String);
    //地圖標題屬性設置
    procedure TitleSetting;
    //圖層屬性設置
    procedure LayerSetting;
    //專題圖屬性設置
    procedure ThemeSetting;
    //查詢對象設置
    procedure SearchSetting;
    //緩沖區分析設置
    procedure AnalyseSetting(AnalyseType: TAnalyseType);
    //保存地圖
    procedure SaveAsGstFile;
    //保存地圖為圖片
    procedure SaveAsGraph;
    //打印地圖
    procedure PrintMap;
    //綁定圖層數據
    procedure BindLayerData(ALayer: string);
    //返回圖層的個數
    function GetLayerCount: Integer;
    //獲得數據集的個數
    function GetDataSetCount: Integer;
    //獲得數據集
    function GetDataSetByName(AName: string): CMapXDataSet;
    //獲得圖層
    function GetLayerByName(AName: string): CMapXLayer;
    //獲得搜索結果
    function GetSearchResult(ALayer, AField, AText: string;
      SearchType: TSearchType): CMapxfeatures;
    //返回幾個對象合并后的對象
    function GetCombinedFeature(Fs: CMapXFeatures): CMapXFeature;
    //獲取對象空間分析的種類
    function GetAnalyseTypes(SourceFs: CMapXFeatures): TAnalyseTypes;
    //獲得空間分析結果
    function GetAnalyseResult(AnalyseType: TAnalyseType; SourceF: CMapXFeature;
      DesLyr: string; Dis: Double): CMapXFeatures;
    //獲得圖層的選擇集
    function GetLayerSelection(ALayer: string): CMapXFeatures;

    property FileName: string read FFileName write SetFileName;
    property WorkLayer: string read FWorkLayer write SetWorkLayer;
    property MouseX: Double read FMouseX;
    property MouseY: Double read FMouseY;
    property FeatureUnderMouse: CMapXFeature read FFeatureUnderMouse;
    property CurrentTool: TMapXToolType read FCurrentTool write SetCurrentTool;
    property MapHandle: HWND read GetMapHandle;
  end;

  THawkMap = class(TMapX)
  private
    FBuddyMapX: TMapX;
    procedure SetFileName(const Value: string); override;
  protected
    procedure MapXOnToolUsed(ASender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: WordBool;
      var EnableDefault: WordBool); override;
    procedure MapXOnMapViewChanged(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetBuddyMap(AMapX: TMapX);
  end;

function CreateToolTipWindow(hWndParent :HWND) :HWND;
procedure AddToolTip(hwnd: DWORD; lpToolInfo: PToolInfo; IconType: Integer;
  Text, Title: PChar; BackColor, TextColor:TColor);

const
 TTS_BALLOON    = $40;
 TTM_SETTITLE = (WM_USER + 32);

var
  hToolTip: HWND;      //氣泡提示窗口句柄
  AToolInfo: TToolInfo;


implementation

uses TitleFrm, SaveFrm, PrintFrm, ThemeFrm, SearchFrm, AnalyseFrm;

//創建氣泡提示窗口
function CreateToolTipWindow(hWndParent :HWND) :HWND;
begin
  //DoInitCommonControls(ICC_WIN95_CLASSES);
  //創建窗口TTS_BALLOON就是泡狀窗口
  Result := CreateWindowEx(WS_EX_TOPMOST, TOOLTIPS_CLASS, nil,
    WS_POPUP or TTS_NOPREFIX or TTS_ALWAYSTIP or TTS_BALLOON,
    CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
    hWndParent, 0, hInstance, nil );
  SetWindowPos(Result, HWND_TOPMOST, 0, 0, 0, 0,
      SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
  //延遲時間可以當參數
  SendMessage(Result,TTM_SETDELAYTIME,TTDT_INITIAL,100);
  SendMessage(Result,TTM_SETDELAYTIME,TTDT_RESHOW, 100 div 5);
  //停留顯示時間
  SendMessage (Result,TTM_SETDELAYTIME,TTDT_AUTOPOP,3000);
end;

procedure AddToolTip(hwnd: DWORD; lpToolInfo: PToolInfo; IconType: Integer;
  Text, Title: PChar; BackColor, TextColor:TColor);
 //BackColor, TextColor分別是背景顏色和文本顏色,如果是0則取默認值.
var
  Rect: TRect;
  Buffer : array[0..255] of Char;
begin
  if (hwnd <> 0) and (GetClientRect(hwnd, Rect)) then
  begin
  
   lpToolInfo.cbSize:= SizeOf(TToolInfo);
   lpToolInfo.uFlags:= TTF_SUBCLASS or TTF_TRANSPARENT;
   lpToolInfo.hInst:= hInstance;
   lpToolInfo.hwnd := hwnd;
   lpToolInfo.uId:= hwnd;
   lpToolInfo.Rect := Rect;
   lpToolInfo.lpszText := Text;

   SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(lpToolInfo));
   FillChar(Buffer, SizeOf(Buffer), #0);
   lstrcpy(Buffer, Title);
   if (IconType > 3) or (IconType < 0) then IconType := 0;
   if BackColor <> 0 then
     SendMessage(hToolTip, TTM_SETTIPBKCOLOR, BackColor, 0);
   if TextColor <> 0 then
     SendMessage(hToolTip, TTM_SETTIPTEXTCOLOR, TextColor, 0);
   SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@Buffer));
  end;
end;

{ TMapX }

constructor TMapX.Create(AOwner: TComponent);
begin
  FMap:= TMap.Create(AOwner);
  FMap.Parent:= TWinControl(AOwner);
  FMap.Align:= alClient;
  FMap.OnMouseDown:= MapXOnMouseDown;
  FMap.OnMouseMove:= MapXOnMouseMove;
  FMap.OnMouseUp:= MapXOnMouseUp;
  FMap.OnToolUsed:= MapXOnToolUsed;
  FMap.OnPolyToolUsed:= MapXOnPolyToolUsed;

  FPointSelectTool:= TPointSelectTool.Create(Self);
  FRadiusSelectTool:= TRadiusSelectTool.Create(Self);
  FRectSelectTool:= TRectSelectTool.Create(Self);
  FPolygonSelectTool:= TPolygonSelectTool.Create(Self);

  FInforTool:= TInforTool.Create(Self);
  FRulerTool:= TRulerTool.Create(Self);
  FAreaTool:= TAreaTool.Create(Self);
  FLabelTool:= TLabelTool.Create(Self);

  FMapXTheme:= TMapXTheme.Create(Self);
end;

destructor TMapX.Destroy;
begin
  FMap.Free;
  FPointSelectTool.Free;
  FRadiusSelectTool.Free;
  FRectSelectTool.Free;
  FPolygonSelectTool.Free;

  FInforTool.Free;
  FRulerTool.Free;
  FAreaTool.Free;
  FLabelTool.Free;

  FMapXTheme.Free;
  inherited;
end;

procedure TMapX.Get_Layers(AList: TStringList);
var
12 3 下一頁
?? 文件大小 150 K
?? 上傳用戶 SnowCat
?? 所屬分類家庭/個人應用
??? 相關標簽

#Delphi #MapX #程序 #地圖
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? mapx.~pas

?? 快捷鍵說明
