ufrmmain.pas

a voice guide client ,it is the second part of voice guide center

//    procedure ShowStopSectHint;
  public
    FIgnorOper: Boolean;
    IsTree : Boolean;
    IsGroupTree : Boolean;
    // 新科安达货物运输管理
//    frmSTGoods: TfrmSTGoods;

    // 石化业务系统
//    frmPetroDBMain: TfrmPetroDBMain;
    frmPetroZPMain: TfrmPetroZPMain;
    frmPetroQFMain: TfrmPetroQFMain;
    frmGPSANAMain:  TfrmGPSANAMain;
    frmGISClientMain:  TfrmGISClientMain;
    frmGPSOILMain:  TfrmGPSOILMain;
    frmMSCMain    : TfrmMSCMain;
    frmDistanceCalcMain: TfrmDistanceCalcMain;
    MonitorClient: TPetroBusinessMonitorClient;
    frmGasLevelInfoMain : TfrmGasLevelInfoMain;
    { Public declarations }
    procedure AddLog(sLog: string);
    procedure LinkTcpSvr(Active: Boolean);
    function LinkDataSvr(Active: Boolean): TLnkDataState;
//    procedure SetActiveTargetReplayWin(CarId: Integer);

    procedure SetLookFeel(LookFeel: TLookFeel);
    //procedure SetTargetShowHint(TargetShowHint: TTargetHintShow);

    procedure DoAfterLogOn;
    procedure DoAfterLogOff;

    procedure SetAllTargetName;
    procedure SetAllTargetTrack;
    procedure SetAllTargetInfo(InfoType: TTargetHintShow);
    procedure SetActiveCarInfo(CarInfo: TCarInfo);

    procedure TargetDelAll;
    procedure ShowReplayTool(Showed: Boolean);

    procedure SetActiveCar(CarId: Integer; Active: Boolean;
      MapFrameType: TMapFrameType);
    function GetCurTargetId(CarId: Integer): Integer;
    function GetReplayTargetId(CarId: Integer): Integer;
    function GetCarId(TargetId: integer): Integer;

    procedure UpdateActiveVehicleAlarm(_vehicle_id: Integer;
      _is_alert: Boolean);

    property MapWinList   : TList
        read FMapWinList;

    property ActiveMapFrame: TFramMap
        read FActiveMapFrame
       write SetActiveMapFrame;
    property ActiveMapView: TGIS_ViewerWnd
        read GetActiveGisViewer;
//    property ActiveTargetCurWin: integer
//       write SetActiveTargetCurWin;
    property ReplayMapFrame: TFramMap
        read FReplayMapFrame;

    //回放
    procedure DoOnViewerAfterPaint(Sender: TObject);
    procedure ReplayBegin(ACarIds: TList);
    procedure ReplayStop;
    procedure ReplayRecvGps(ACarId: Integer; GpsData: TGpsData; _cur_index: Integer);
    procedure ReplayBackOnePoint(ACarId: Integer);
    procedure ReplayFlushMap;

    //************************** View     Call  *****************************
    procedure SaveInterfaceIni(AIniFile: TIniFile);
    procedure ReadInterfaceIni(AIniFile: TIniFile);

//    procedure SetTargetStatus(_target_id: Integer; _gps_info: TGpsInfo);
//    procedure ClearActiveTargets;

    //KEN EDIT
    procedure OpenGpsJudge;
    //
    procedure UniteMsgDel(AMsgId: Cardinal);
    procedure ShowFunctionByPurview;

    //删除指定的信息，让当前信息及轨迹回放信息中一致

    procedure AddDebugInfo(_info_str: string);
    procedure AddCommandInfo(_info_str: string);
    procedure AddDebugDBInfo(_info_str: string);

    procedure disableCommandSendCallInterval;
    procedure disableCommandSendCallOne;

    function GetPositionFromXY(AX, AY: Double; AViewerBmp: TGIS_Viewer;
      var _road_distance: Double): String;

    procedure AddOperationDescToActiveVehicleListDisplay(_vehicle_id: Integer;
      _operation_type_id: Integer; _operation_name: string);
  end;

var
  frmMain: TfrmMain;
  LastDateTime:TDateTime;
  SelectVehicle: string;

implementation

uses uDm, uFrmOption, uFrmSysSett, uFaceFun, uFrmSelListView,
  uFrmCmdSend, uFrmAreaSelCar, uFrmReplay, uFrmEm, uFrmShowCarInfo,
  uFrmGpsReport, uFrmQryStayLong, uFrmTaxiStat, uFrmTaxiStatChart, uFrmLyrCtrl,
  uFrmShowMsg, uFrmAlarmQry, uFrmPriceBaseData, uFrmLaterAlarmSet,
  uTaxiPub, uFrmTaxiSheet, uFrmTaxiLook, uFrmTaxiLawsuit, uFrmTaxiLostRec,
  uFramCustomerSendCmd, RestAlertSetup, DB, uCustomerInOutAlert,
  uOilAppComm, uFrmShowCarInfo4Oil, Math, ufrmVehicleQuery, ufrmSpeedChart,
  uRealTimeMileage;

{$R *.dfm}

type

  PDaemonTask   = ^TDaemonTask;
  TDaemonTask   = record
    taskName    : String;
    DoTask      : TThreadMethod;
  end;

  TDaemonWorker = class(TThread)
  private
    FTasks      : TThreadList;
    procedure   Run;
    procedure   Execute; override;
  public
    constructor Create;
    destructor  Destroy; override;

    procedure   AddDaemonTask( _name: String; _ev: TThreadMethod );
    procedure   ClearTasks;
  end;

procedure TDaemonWorker.AddDaemonTask(_name: String; _ev: TThreadMethod);
var
  i       : Integer;
  p_task  : PDaemonTask;
  b_found : Boolean;
begin

  with FTasks.LockList do
  try
    b_found := False;

    for i := 0 to Count - 1 do
    begin
      p_task  := Items[i];
      b_found := ( p_task.taskName = _name );
      if b_found then Break;
    end;

    if not b_found then
    begin
      new( p_task );
      p_task.taskName := _name;
      p_task.DoTask   := _ev;

      Add( p_task );
    end;

  finally
    FTasks.UnlockList;
  end;

  if self.Suspended then
    self.Resume;
end;

procedure TDaemonWorker.ClearTasks;
var
  p_task  : PDaemonTask;
begin
  with FTasks.LockList do
  try
    while Count > 0 do
    begin
      p_task  := Items[0];
      Delete(0);
      Dispose( p_task );
    end;
  finally
    FTasks.UnlockList;
  end;
end;

constructor TDaemonWorker.Create;
begin
  inherited Create( True );
  FreeOnTerminate := False;
  FTasks    := TThreadList.Create;
end;

destructor TDaemonWorker.Destroy;
begin
  ClearTasks;
  FTasks.Free;
  inherited;
end;

procedure TDaemonWorker.Execute;
begin
  while Assigned(Self) and (not Terminated) do
    run;
end;

procedure TDaemonWorker.Run;
var
  p_task  : PDaemonTask;
begin

  p_task  := nil;
  with FTasks.LockList do
  try
    if Count > 0 then
    begin
      p_task  := Items[0];
      Delete(0);
    end;
  finally
    FTasks.UnlockList;
  end;

  if p_task = nil then
    self.Suspend
  else
  begin
    p_task.DoTask;
    //Synchronize( p_task.DoTask );
    Dispose( p_task );
  end;

end;

resourcestring
  {$IFDEF _POLICE}
    rsCarInfo = '警车信息';
  {$ELSE}
    rsCarInfo = '车辆信息';
  {$ENDIF}
//  rsRestAlert = '疲劳报警!请注意车辆%s';
//  rsEarlyAlert = '提前进站报警!
  rsAlertTitle = '报警';

{ TfrmMain }

procedure TfrmMain.AddLog(sLog: string);
var
  p_memo_data : PMemoData;
begin
  { TODO -oTransit -cMainForm : 日志功能 ./Log }
  //TbLogFile1.WriteLnLog(sLog);
  try
    if Assigned(vtMemo) then
    begin
      New(p_memo_data);
      p_memo_data^.MemoStr := FormatDateTime('yyyy-mm-dd hh:nn:ss> ', Now)+ sLog;
      vtMemo.AddChild(nil, p_memo_data);
    end;
  except
    on e: Exception do
    begin
      MessageBox(Handle,PChar(E.Message),PChar('AddLog'),MB_OK+MB_ICONERROR);
    end;
  end;
end;

function TfrmMain.LinkDataSvr(Active: Boolean): TLnkDataState;
var
  sLog: string;
  DoResult: Boolean;
begin
  Result:= ldsLinkErr;
  try
    if Active then begin
      //连接数据服务
      with uDm.DataModule1 do begin
        //物理连接
        sLog:= Format(rsLinkDb+ ':(%s On Port:%d)', [gDataHost, gDataPort]); //Format('联接数据库:(%s On Port:%d)', [gDataHost, gDataPort]);
        DoResult:= False;

        Try
          // 如果不是BaseDB认证
          if not GIsBaseDBAuth then
          begin
            if not gUseAuthServer then
            begin
//              DoResult:= OpenDB(gDataHost, gDataPort);
              DoResult := True;  
            end
            else begin
              DoResult:= OpenAuthDB(gAuthServerHost, gAuthServerPort);
            end;
          end
          else begin
            try
//              cdsAuth   := BaseDBDataModule.ClientDataSetByName(APP_BASEDB_AUTH_NAME);
              DoResult  := True;
            except
            end;
          end;

          if DoResult then  sLog:= sLog+ rsSucceed        //'成功!'
          else begin
            sLog:= sLog+ rsFail;                          //'失败!';
            Result:= ldsLinkErr;
          end;
        except
          on E: Exception do begin
            sLog:= sLog+ rsFail+ rsErrorCode+ E.Message;//'失败!'+ '错误代码：'+ E.Message;
            Result:= ldsLinkErr;
          end;
        end;


        AddLog(sLog);
        Application.ProcessMessages;
        //登陆
        if DoResult then
        begin
          //sLog:= Format('登录数据库(%s ，%s)', [gLogName,  StringOfChar('*', Length(gPassWd))]);
          sLog:= Format(rsLogDB+ '(%s ，%s)', [gLogName,  StringOfChar('*', Length(gPassWd))]);
          AddDebugInfo('login--Before Logon');
          Result:= LogOn(gLogName, gPassWd);
          AddDebugInfo('login--After Logon');
          case Result of
            ldsOk: sLog:= sLog+ rsSucceed; //'成功!';
          else
            sLog:= sLog+ rsFail; //'失败!';
          end;
          AddLog(sLog);
          AddDebugInfo('login--Before CloseDB');
          if not gIsCacheLogon then
            CloseDB;

          if gIsCacheLogon and isEndThread then
            CloseDB;
          AddDebugInfo('login--End CloseDB');

          AddDebugInfo('login--Link MTSC');
          //联接MTSC
          if DoResult and (Result = ldsOk) then
          begin
            AddDebugInfo('login--Link MTSC Post MSG');
            PostMessage(Handle, WM_LinkTcp, 1, 0);
          end;//LinkTcpSvr(True);
        end;
      end;
    end else begin
      //断开数据服务
      //Link2002(False);
      { TODO -oTransit -cMainForm : 注销成功 }
  //    tvGroupFleet.Items.Clear;
  //    lvCarInfo.Clear;
      InitInfoList;
      with uDm.DataModule1 do begin
        Logoff;
        CloseDB;
      end;
    end;
  except
    on e: Exception do
    begin
      MessageBox(Handle,PChar(E.Message),PChar('LinkDataSvr'),MB_OK+MB_ICONERROR);
    end;
  end;
end;

procedure TfrmMain.LinkTcpSvr(Active: Boolean);
begin