unitnavigation.pas

在delphi下基于MapX5.0的GIS程序

unit UnitNavigation;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Buttons, ExtCtrls;

type
  TFrmNavigation = class(TForm)
    SBtnUp: TSpeedButton;
    SBtnLeft: TSpeedButton;
    SBtnWholeMap: TSpeedButton;
    SBtnRight: TSpeedButton;
    SBtnDown: TSpeedButton;
    TimerMoveMap: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure TimerMoveMapTimer(Sender: TObject);
    procedure SBtnWholeMapClick(Sender: TObject);
    procedure SBtnUpMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SBtnUpMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SBtnLeftMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SBtnDownMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure SBtnRightMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    MouseDown : Boolean;
    MouseX, MouseY: Integer;
    { Private declarations }
  public
    { Public declarations }
  end;
  
const
// Move_Direction
  DIRECTION_STOP = 0;
  DIRECTION_UP = 1;
  DIRECTION_DOWN = 2;
  DIRECTION_LEFT = 3;
  DIRECTION_RIGHT = 4;

var
  FrmNavigation: TFrmNavigation;
// 方向盘方向
  Move_Direction : Integer;   // Record Moveing Direction

implementation

uses UnitMain;

{$R *.dfm}


procedure TFrmNavigation.FormCreate(Sender: TObject);
var
  l: longint;
  R : HRgn;
begin
// 半透明窗体
  l:=getWindowLong(Handle, GWL_EXSTYLE);
  l := l Or WS_EX_LAYERED;
  SetWindowLong (handle, GWL_EXSTYLE, l);
  SetLayeredWindowAttributes (handle, 0, 180, LWA_ALPHA);
// 圆形窗体
  Width := Height;
  R := CreateEllipticRgn(0, 0, Width, Height);
  SetWindowRgn(Handle,R,True);
//
  MouseDown:=False;
end;

procedure TFrmNavigation.TimerMoveMapTimer(Sender: TObject);
begin
//  direction control
  With FrmMain do
    begin
    Case Move_Direction of
      DIRECTION_STOP : TimerMoveMap.Enabled := False;
      DIRECTION_UP : Map1.CenterY:=Map1.CenterY-0.1;
      DIRECTION_DOWN : Map1.CenterY:=Map1.CenterY+0.1;
      DIRECTION_LEFT : Map1.CenterX:=Map1.CenterX+0.1;
      DIRECTION_RIGHT : Map1.CenterX:=Map1.CenterX-0.1;
    end;
  end;
end;

procedure TFrmNavigation.SBtnWholeMapClick(Sender: TObject);
begin
//  view the whole map
  FrmMain.Map1.Bounds := FrmMain.Map1.Layers.Bounds;
end;

procedure TFrmNavigation.SBtnUpMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Move_Direction := DIRECTION_UP;
  TimerMoveMap.Enabled := True;
end;

procedure TFrmNavigation.SBtnUpMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Move_Direction := DIRECTION_STOP;
end;

procedure TFrmNavigation.SBtnLeftMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Move_Direction := DIRECTION_LEFT;
  TimerMoveMap.Enabled := True;
end;

procedure TFrmNavigation.SBtnDownMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Move_Direction := DIRECTION_DOWN;
  TimerMoveMap.Enabled := True;
end;

procedure TFrmNavigation.SBtnRightMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  Move_Direction := DIRECTION_RIGHT;
  TimerMoveMap.Enabled := True;
end;

procedure TFrmNavigation.FormMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then
    begin
      MouseX := X;
      MouseY := Y;
      MouseDown := True;
    end;
end;

procedure TFrmNavigation.FormMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if MouseDown then
    begin
      Left := Left+X-MouseX;
      Top := Top+Y-MouseY;
    end;
end;

procedure TFrmNavigation.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button=mbLeft then
    MouseDown := False;
end;

end.