unitnavigation.pas

此代码是关于mapgis的在

unit UnitNavigation;

interface

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

type
  TNavegateEvent=procedure (Sender:TObject; Direction:Integer) of object;
  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;
    FOnNavigate: TNavegateEvent;
    { Private declarations }
  public
    { Public declarations }
    property OnNavigate:TNavegateEvent read FOnNavigate write FOnNavigate;
  end;
  
const
// Move_Direction
  DIRECTION_STOP   = 0;
  DIRECTION_UP     = 1;
  DIRECTION_DOWN   = 2;
  DIRECTION_LEFT   = 3;
  DIRECTION_RIGHT  = 4;
  DIRECTION_WHOLE  = 5;

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

implementation

{$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(1, 1, Width, Height);
  SetWindowRgn(Handle,R,True);
//
  MouseDown:=False;
end;

procedure TFrmNavigation.TimerMoveMapTimer(Sender: TObject);
begin
//  direction control
  Case Move_Direction of
    DIRECTION_STOP : begin
      TimerMoveMap.Enabled := False;
    end;
    DIRECTION_UP,
    DIRECTION_DOWN,
    DIRECTION_LEFT,
    DIRECTION_RIGHT: begin
      if Assigned(FOnNavigate) then
        FOnNavigate(Self, Move_Direction);  
    end;
  end;
end;

procedure TFrmNavigation.SBtnWholeMapClick(Sender: TObject);
begin
  if Assigned(FOnNavigate) then
    FOnNavigate(Self, DIRECTION_WHOLE);  
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.