⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 urealtimemileage.pas

📁 a voice guide client ,it is the second part of voice guide center
💻 PAS
字号:
unit uRealTimeMileage;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, VirtualTrees, ImgList, cxTextEdit, cxMaskEdit, cxDropDownEdit,
  cxCalendar, cxControls, cxContainer, cxEdit, cxLabel, dxNavBarCollns,
  dxNavBarBase, ExtCtrls, dxNavBar , etHash , uMileageGetter, Menus,
  XLSReadWriteII, ActnList;

type
  TfrmRealTimeMileage = class(TForm)
    dxNavBar1: TdxNavBar;
    dxNavBar1Group1: TdxNavBarGroup;
    dxNavBar1Group2: TdxNavBarGroup;
    biYesterday: TdxNavBarItem;
    biToday: TdxNavBarItem;
    biThisMonth: TdxNavBarItem;
    biLastMonth: TdxNavBarItem;
    dxNavBar1Group1Control: TdxNavBarGroupControl;
    cxLabel12: TcxLabel;
    dtedtFrom: TcxDateEdit;
    cxLabel13: TcxLabel;
    dtedtTo: TcxDateEdit;
    ilSmall: TImageList;
    ilLarge: TImageList;
    vtRes: TVirtualStringTree;
    dxNavBar1Group3: TdxNavBarGroup;
    dxNavBar1Group3Control: TdxNavBarGroupControl;
    vtCar: TVirtualStringTree;
    SaveDialog1: TSaveDialog;
    PopupMenu1: TPopupMenu;
    Excel1: TMenuItem;
    XLSReadWriteII1: TXLSReadWriteII;
    ActionList1: TActionList;
    acExport: TAction;
    acRefresh: TAction;
    N1: TMenuItem;
    procedure biThisMonthClick(Sender: TObject);
    procedure dtedtFromPropertiesChange(Sender: TObject);
    procedure vtResGetNodeDataSize(Sender: TBaseVirtualTree;
      var NodeDataSize: Integer);
    procedure vtCarInitNode(Sender: TBaseVirtualTree; ParentNode,
      Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
    procedure vtCarChecking(Sender: TBaseVirtualTree; Node: PVirtualNode;
      var NewState: TCheckState; var Allowed: Boolean);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure vtResGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure vtCarGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
      Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: WideString);
    procedure acExportExecute(Sender: TObject);
    procedure acExportUpdate(Sender: TObject);
    procedure acRefreshExecute(Sender: TObject);
  private
    FStatCars : TEtIntHashTable;
    FIndex    : Integer;

    procedure ExportInfo( const _cid: Integer; const _val: Pointer );
    procedure QueryMileage( const _cid: Integer; const _val: Pointer );
    function  getCarMileage( cid: Cardinal ): Double;
    function  getCarMaxSpeed( cid: Cardinal ): Integer;

    function  FindNodeByData( vt: TVirtualStringTree; ref: Pointer ): PVirtualNode;

    procedure RefreshMileages;
  public
    { Public declarations }
  end;

var
  frmRealTimeMileage: TfrmRealTimeMileage;

implementation  

uses
  uPubFun
  , uGPSANAUtils
  , DateUtils
  , uDm, DB;

{$R *.dfm}

type
  PMyNode = ^TMyNode;
  TmyNode = record
    ref : Pointer;
  end;

  PMyCarMileage = ^TMyCarMileage;
  TMyCarMileage = record
    CarRef      : TCarInfo;

    InStat      : Boolean;
    MileageVal  : Double;
    MaxSpeed    : Integer;
  end;


procedure TfrmRealTimeMileage.biThisMonthClick(Sender: TObject);
var
  do_on_change              : TNotifyEvent;
begin
  do_on_change := dtedtFrom.Properties.OnChange;

  dtedtFrom.Properties.OnChange := nil;
  dtedtTo.Properties.OnChange := nil;

  case TComponent(Sender).Tag of
    0:
    begin
      dtedtFrom.Date := Now;
      dtedtTo.Date   := Now;
    end;
    1:
    begin
      dtedtFrom.Date := Now - 1;
      dtedtTo.Date   := Now - 1;
    end;
    2:
    begin
      dtedtFrom.Date := EncodeDate(YearOf(Now), MonthOf(Now), 1);
      dtedtTo.Date   := Now;
    end;
    3:
    begin
      if MonthOf(Now) = 1 then
      begin
        dtedtFrom.Date := EncodeDate(YearOf(Now) - 1, 12, 1);
        dtedtTo.Date := EncodeDate(YearOf(Now), 1, 1) - 1;
      end
      else begin
        dtedtFrom.Date := EncodeDate(YearOf(Now), MonthOf(Now) - 1, 1);
        dtedtTo.Date := EncodeDate(YearOf(Now), MonthOf(Now), 1) - 1;
      end;

    end;
  end;

  dtedtFrom.Properties.OnChange  := do_on_change;
  dtedtTo.Properties.OnChange    := do_on_change;

  dtedtFrom.Properties.OnChange(dtedtFrom);
end;

procedure TfrmRealTimeMileage.ExportInfo(const _cid: Integer;
  const _val: Pointer);
var
  mpc     : PMyCarMileage;
  car     : TCarInfo;
begin
  mpc := _val;
  if not mpc^.InStat then
    exit;

  car := mpc^.CarRef;

  XLSReadWriteII1.Sheets[0].AsWideString[0,FIndex + 1] := car.VehicleCommIDStringShort;
  XLSReadWriteII1.Sheets[0].AsWideString[1,FIndex + 1] := car.VehicleRegistrationNO;
  XLSReadWriteII1.Sheets[0].AsWideString[2,FIndex + 1] := Format( '%.2f 公里', [ mpc.MileageVal / 1000 ] );
  XLSReadWriteII1.Sheets[0].AsWideString[3,FIndex + 1] := Format( '%d(公里/小时)', [ mpc.MaxSpeed ] );

  Inc( FIndex );
end;


procedure TfrmRealTimeMileage.QueryMileage(const _cid: Integer;
  const _val: Pointer);
var
  mpc : PMyCarMileage;
  car : TCarInfo;
begin
  mpc := _val;
  if not mpc^.InStat then
    exit;

  car := mpc^.CarRef;

  mpc^.MileageVal := getCarMileage( car.VehicleCommIDCardinal );
  mpc^.MaxSpeed   := getCarMaxSpeed( car.VehicleCommIDCardinal );
end;

procedure TfrmRealTimeMileage.dtedtFromPropertiesChange(Sender: TObject);
begin
//  if Sender <> nil then
//    if not ShowConfirmEx('更改时间筛选条件', '您是否确定要更改时间筛选条件?') then
//      Exit;
  RefreshMileages;
end;

procedure TfrmRealTimeMileage.vtResGetNodeDataSize(
  Sender: TBaseVirtualTree; var NodeDataSize: Integer);
begin
  NodeDataSize  := SizeOF( TMyNode );
end;

procedure TfrmRealTimeMileage.vtCarInitNode(Sender: TBaseVirtualTree;
  ParentNode, Node: PVirtualNode;
  var InitialStates: TVirtualNodeInitStates);
begin
  Node.CheckType  := ctCheckBox;
end;

procedure TfrmRealTimeMileage.vtCarChecking(Sender: TBaseVirtualTree;
  Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean);
var
  cd  : PMyNode;
  mpc : PMyCarMileage;
  nnd : PVirtualNode;
begin
  cd  := vtCar.GetNodeData( Node );
  mpc := cd.ref;

  case NewState of
    csCheckedNormal  : mpc.InStat := True;
    csUncheckedNormal: mpc.InStat := False;
  end;

  if mpc.InStat then
  begin
    nnd :=  FindNodeByData( vtRes, mpc );
    if nnd = nil then
      vtRes.AddChild( nil, mpc );
  end
  else
  begin
    nnd :=  FindNodeByData( vtRes, mpc );
    if nnd <> nil then
      vtRes.DeleteNode( nnd );
  end;
  
end;

procedure TfrmRealTimeMileage.FormDestroy(Sender: TObject);
begin
  FStatCars.Clear( true );
  FStatCars.Free;
end;

procedure TfrmRealTimeMileage.FormCreate(Sender: TObject);
var
  i   : Integer;
  ci  : TCarInfo;
  mcp : PMyCarMileage;
begin
  FStatCars := TEtIntHashTable.Create(  etHitInteger, 256 );

  dtedtFrom.Properties.OnChange := nil;
  dtedtFrom.Date  := Now;
  dtedtTo.Date  := Now;
  dtedtFrom.Properties.OnChange := dtedtFromPropertiesChange;

  for i := 0 to gCarInfoList.Count - 1 do
  begin
    ci  := TCarInfo( gCarInfoList.objects[i] );

    new( mcp );
    mcp^.CarRef     := ci;
    mcp^.InStat     := False;
    mcp^.MileageVal := 0;
    mcp^.maxSpeed   := 0;

    FStatCars.Add( ci.VehicleCommIDCardinal, mcp ); 

    vtCar.AddChild( nil, mcp );
  end;

end;

procedure TfrmRealTimeMileage.vtResGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var
  cd    : PMyNode;
  mpc   : PMyCarMileage;
  car   : TCarInfo;
  col   : TVirtualTreeColumn;
begin
  CellText  := '';

  cd  := vtRes.GetNodeData( Node );
  col := vtRes.Header.Columns[Column];

  mpc := cd.ref;
  car := mpc.CarRef;

  case col.Tag of
    0 : CellText  := car.VehicleCommIDStringShort;
    1 : CellText  := car.VehicleRegistrationNO;
    2 : CellText  := Format( '%.2f', [ mpc.MileageVal / 1000 ] );
    3 : CellText  := Format( '%d', [ mpc.MaxSpeed ] );
  end;

end;

procedure TfrmRealTimeMileage.vtCarGetText(Sender: TBaseVirtualTree;
  Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: WideString);
var            
  cd    : PMyNode;
  mpc   : PMyCarMileage;
  car   : TCarInfo;
  col   : TVirtualTreeColumn;
begin
  CellText  := '';

  cd  := vtCar.GetNodeData( Node );
  col := vtCar.Header.Columns[Column];

  mpc := cd.ref;
  car := mpc.CarRef;

  case col.Tag of
    0 : CellText  :=  car.VehicleRegistrationNO;
  end;

end;

function TfrmRealTimeMileage.getCarMaxSpeed(cid: Cardinal): Integer;
var
  dts,
  dte     : String;

  sql     : String;
begin
  dts     := FormatDateTime('yyyy-mm-dd 00:00:00', dtedtFrom.Date);
  dte     := FormatDateTime('yyyy-mm-dd 23:59:59', dtedtTo.Date);

  Result  := -1;
  sql     := Format( 'exec QueryCarMaxSpeed %d,%s,%s', [ cid, QuotedStr(dts), QuotedStr(dte) ] );
  with DataModule1 do
  try
    cdsCustomer.Close;
    cdsCustomer.CommandText := sql;
    cdsCustomer.Open;
    if not cdsCustomer.Eof then
      Result  := cdsCustomer.FieldByName('MaxSpeed').AsInteger;
  except
  end;

end;

{
  求车辆里程信息
}
function TfrmRealTimeMileage.getCarMileage(cid: Cardinal): Double;
var
  dts,
  dte     : String;

  sql     : String;
begin
  dts     := FormatDateTime('yyyy-mm-dd 00:00:00', dtedtFrom.Date);
  dte     := FormatDateTime('yyyy-mm-dd 23:59:59', dtedtTo.Date);

  Result  := -1;
  sql     := Format( 'exec QueryCarMileage %d,%s,%s', [ cid, QuotedStr(dts), QuotedStr(dte) ] );
  with DataModule1 do
  try
    cdsCustomer.Close;
    cdsCustomer.CommandText := sql;
    cdsCustomer.Open;
    if not cdsCustomer.Eof then
      Result  := cdsCustomer.FieldByName('res_mileage').AsFloat;
  except
  end;

end;

function TfrmRealTimeMileage.FindNodeByData(vt: TVirtualStringTree;
  ref: Pointer): PVirtualNode;
var
  pnd : PVirtualNode;
  cd  : PMyNode;
begin
  Result  := nil;
  pnd := vt.GetFirst;
  while pnd <> nil do
  begin
    cd  := vt.GetNodeData( pnd );
    if cd.ref = ref then
    begin
      Result  := pnd;
      Exit;
    end;

    pnd := vt.GetNext( pnd );
  end;
end;

procedure TfrmRealTimeMileage.RefreshMileages;
begin
  screen.Cursor := crHourGlass;
  FStatCars.DoOnEachItem( QueryMileage );
  vtRes.Invalidate;
  screen.Cursor := crDefault;
end;

procedure TfrmRealTimeMileage.acExportExecute(Sender: TObject);
var
  sFileName:String;
begin
  if SaveDialog1.Execute then
  begin
    sFileName := SaveDialog1.FileName;
    if FileExists(sFileName) then
    begin
      if MessageBox(Handle,PChar('文件已经存在,覆盖吗?'),PChar('提示'),MB_YESNO + MB_ICONQUESTION)=IDNO then
        Exit;
    end;

    SaveDialog1.InitialDir  := ExtractFilePath(Application.ExeName);
    XLSReadWriteII1.ClearCells;
    XLSReadWriteII1.Sheets[0].AsWideString[0,0] := '车辆编号';
    XLSReadWriteII1.Sheets[0].AsWideString[1,0] := '车牌号码' ;
    XLSReadWriteII1.Sheets[0].AsWideString[2,0] := '里程数';  
    XLSReadWriteII1.Sheets[0].AsWideString[3,0] := '最高速度';
    FIndex  := 0;
    FStatCars.DoOnEachItem( ExportInfo );
    XLSReadWriteII1.FileName:= sFileName;
    XLSReadWriteII1.Write;
    MessageBox(Handle,PChar('导出完毕!'),PChar('提示'),MB_OK);
  end;
end;

procedure TfrmRealTimeMileage.acExportUpdate(Sender: TObject);
begin
  acExport.Enabled  := vtRes.RootNodeCount > 0;
end;

procedure TfrmRealTimeMileage.acRefreshExecute(Sender: TObject);
begin
  RefreshMileages;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -