cartrackerfrm.pas

GIS地理信息系统开发。 大名鼎鼎的MAPX＋DELPHI7.0软件开发

// This sample application and corresponding sample code is provided
// for example purposes only.  It has not undergone rigorous testing
// and as such should not be shipped as part of a final application
// without extensive testing on the part of the organization releasing
// the end-user product.

unit CarTrackerFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, OleCtrls, MapXLib_TLB, ComObj;

type
  TfrmCarTracker = class(TForm)
    cmdPlotCar: TButton;
    cmdSetStyle: TButton;
    cmdLayerControl: TButton;
    Timer1: TTimer;
    vehicleLabel: TLabel;
    lstCars: TListBox;
    grpbxVehicleInformation: TGroupBox;
    lblVehicleName: TLabel;
    lblVehicleHeading: TLabel;
    lblVehicleSpeed: TLabel;
    txtVehicleName: TEdit;
    txtVehicleHeading: TEdit;
    txtVehicleSpeed: TEdit;
    ZoomInBtn: TButton;
    ZoomOutBtn: TButton;
    Map1: TMap;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure cmdPlotCarClick(Sender: TObject);
    procedure cmdSetStyleClick(Sender: TObject);
    procedure cmdLayerControlClick(Sender: TObject);
    procedure Map1ToolUsed(Sender: TObject; ToolNum: Smallint; X1, Y1, X2,
      Y2, Distance: Double; Shift, Ctrl: Wordbool;
      var EnableDefault: Wordbool);
    procedure lstCarsClick(Sender: TObject);
    procedure txtVehicleNameChange(Sender: TObject);
    procedure txtVehicleHeadingChange(Sender: TObject);
    procedure txtVehicleSpeedChange(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Map1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ZoomInBtnClick(Sender: TObject);
    procedure ZoomOutBtnClick(Sender: TObject);
  private
    procedure updateListCars;
  public
    { Public declarations }
  end;

type
  TVehicle = record
     fFeature : Variant;
     sName : String;
     iSpeed : Integer;
     dHeading : Double;
  end;

Const
     PLOT_VEHICLE_TOOL = 1;
     VEHICLE_LIMIT = 9;

var
  frmCarTracker: TfrmCarTracker;
  fArray: Array[0..VEHICLE_LIMIT] of TVehicle;
  lyrMyLayer: Variant;
  st: Variant;
  iVehicleCount: Integer;
  iCarNum: Integer;

implementation

{$R *.DFM}

procedure TfrmCarTracker.FormCreate(Sender: TObject);
begin
     // Set vehicle count initially to zero
     iVehicleCount := 0;

     // disable data text boxes initially
     txtVehicleName.Enabled := False;
     txtVehicleHeading.Enabled := False;
     txtVehicleSpeed.Enabled := False;
end;

procedure TfrmCarTracker.FormActivate(Sender: TObject);
var
   unusedVt: OleVariant;
   MyFont: TFont;
begin
     TVarData(unusedVt).vType := varError;
     TVarData(unusedVt).vError := 2147614724; // DISP_E_PARAMNOTFOUND;
     // Add car layer and make it an animation layer
     lyrMyLayer := Map1.Layers.CreateLayer('Cars', unusedVt, 1, unusedVt, unusedVt);
     Map1.Layers.AnimationLayer := Map1.Layers.Item[lyrMyLayer.name];

     // Create custom tool to be used to plot vehicles
     Map1.CreateCustomTool(PLOT_VEHICLE_TOOL, miToolTypePoint, miSizeCursor, miSizeCursor, miSizeCursor, unusedVt);

     MyFont := TFont.Create;
     OleFontToFont(Map1.DefaultStyle.SymbolFont, MyFont);
     MyFont.Size := 24;
     MyFont.Name := 'MapInfo Transportation';
     Map1.DefaultStyle.SymbolCharacter := 66;
end;

procedure TfrmCarTracker.cmdPlotCarClick(Sender: TObject);
begin
     // Set active tool to be vehicle plotting tool
     Map1.CurrentTool := PLOT_VEHICLE_TOOL;
end;

procedure TfrmCarTracker.cmdSetStyleClick(Sender: TObject);
begin
     // Display symbol picker dialog
     Map1.DefaultStyle.PickSymbol;
end;

procedure TfrmCarTracker.cmdLayerControlClick(Sender: TObject);
var
   unusedVt: OleVariant;
begin
     TVarData(unusedVt).vType := varError;
     TVarData(unusedVt).vError := 2147614724; //DISP_E_PARAMNOTFOUND;
     // Display MapX stock layer control dialog
     Map1.Layers.LayersDlg(unusedVt, unusedVt);
end;

procedure TfrmCarTracker.Map1ToolUsed(Sender: TObject; ToolNum: Smallint;
  X1, Y1, X2, Y2, Distance: Double; Shift, Ctrl: Wordbool;
  var EnableDefault: Wordbool);
var
   fNewSymbol: Variant;
   fMapSymbol: Variant;
   fFtrFactory : Variant;
   pItem : Variant;
begin
   Case ToolNum of
      PLOT_VEHICLE_TOOL :
      begin
         if iVehicleCount <= 9 then
            begin
               // Create standAlone feature object
               fFtrFactory := Map1.FeatureFactory;

               // Create point object to pass to CreateSymbol
               pItem := CreateOleObject('MapX.Point.5');
               pItem.Set(X1, Y1);

               //User Feature Factory to create new Feature
               fNewSymbol := fFtrFactory.CreateSymbol(pItem, Map1.DefaultStyle);

               // Add Feature to layer
               fMapSymbol := lyrMyLayer.AddFeature(fNewSymbol);

               // Set form controls for newly added feature
               fArray[iVehicleCount].fFeature := fMapSymbol;
               fArray[iVehicleCount].iSpeed := 0;
               fArray[iVehicleCount].dHeading := 0;
               fArray[iVehicleCount].sName := 'Vehicle ' + intToStr(iVehicleCount + 1);

               // call updatelist function
               updateListCars;

               // increase vehicle count by 1
               iVehicleCount := iVehicleCount + 1;

               // clear memory of variant variables
               VarClear(fNewSymbol);
               VarClear(fMapSymbol);
            end
         else
                  ShowMessage('Reached Car Limit. Limit: 10');
      end // Case PLOT_VEHICLE_TOOL
   end // Case Statement
end;

procedure TfrmCarTracker.updateListCars;
var
   iCount: Integer;
   iSelected: Integer;
begin
     // Clear listbox and re-add all vehicl
     iSelected := lstCars.ItemIndex;
     lstCars.Clear;
     for iCount := 0 to iVehicleCount do
         lstCars.Items.Add(fArray[iCount].sName);
     lstCars.ItemIndex := iSelected;
end;

procedure TfrmCarTracker.lstCarsClick(Sender: TObject);
var
   sTemp: String;
begin
     iCarNum := lstCars.ItemIndex;
     // update controls when different vehicle is chosen in the
     // vehicle list box
     txtVehicleName.Enabled := True;
     txtVehicleHeading.Enabled := True;
     txtVehicleSpeed.Enabled := True;

     txtVehicleName.Text := fArray[iCarNum].sName;

     Str(fArray[iCarNum].dHeading:5:0, sTemp);
     txtVehicleHeading.Text := TrimLeft(sTemp);

     txtVehicleSpeed.Text := intToStr(fArray[iCarNum].iSpeed);
end;

procedure TfrmCarTracker.txtVehicleNameChange(Sender: TObject);
begin
     // If vehicle name is changed, update the feature
     fArray[iCarNum].sName := txtVehicleName.Text;
     fArray[iCarNum].fFeature.KeyValue := txtVehicleName.Text;
     fArray[iCarNum].fFeature.Update;
     updateListCars;
end;

procedure TfrmCarTracker.txtVehicleHeadingChange(Sender: TObject);
begin
     if txtVehicleHeading.Text <> '' then
        begin
           fArray[iCarNum].dHeading := StrToFloat(txtVehicleHeading.Text);
           fArray[iCarNum].fFeature.Update;
        end;
end;

procedure TfrmCarTracker.txtVehicleSpeedChange(Sender: TObject);
begin
     if txtVehicleSpeed.Text <> '' then
        begin
           fArray[iCarNum].iSpeed := StrToInt(txtVehicleSpeed.Text);
           fArray[iCarNum].fFeature.Update;
        end;
end;

procedure TfrmCarTracker.Timer1Timer(Sender: TObject);
var
   dYcomp, dXcomp, dYpos, dXpos: Double;
   iCount: Integer;
begin
     for iCount := 0 to iVehicleCount - 1 do
        begin
           if fArray[iCount].iSpeed <> 0 then
              begin
                 with fArray[iCount] do
                    begin
                       dYcomp := iSpeed * Sin(dHeading * 3.14159 / 180);
                       dXcomp := iSpeed * Cos(dHeading * 3.14159 / 180);
                       dYpos := fFeature.CenterY + (1 / 69 * dYcomp * Timer1.interval / 1000 * 1 /3600);
                       dXpos := fFeature.CenterX + (1 / 69 * dXcomp * Timer1.interval / 1000 * 1 /3600);
                       fFeature.Point.Set(dXpos, dYpos);
                       fFeature.Update;
                    end; //with
              end; //if
        end; //for
end;

procedure TfrmCarTracker.Map1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
     case button of
        mbRight : Map1.PropertyPage;
     end;
end;

procedure TfrmCarTracker.ZoomInBtnClick(Sender: TObject);
begin
     Map1.CurrentTool := miZoomInTool;
end;

procedure TfrmCarTracker.ZoomOutBtnClick(Sender: TObject);
begin
     Map1.CurrentTool := miZoomOutTool;
end;

end.