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

📄 umileagestat.pas

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, dxDockControl, dxDockPanel, cxLookAndFeelPainters, StdCtrls,uDm,
  cxButtons, ExtCtrls, RzPanel, ComCtrls,uPubFun,DateUtils, RzPrgres,
  XLSReadWriteII;

type
  TFrmMileageStat = class(TForm)
    dxDockSite1: TdxDockSite;
    dxDockPanel1: TdxDockPanel;
    dxLayoutDockSite1: TdxLayoutDockSite;
    RzGroupBox1: TRzGroupBox;
    txtCarID: TEdit;
    lstCarList: TListBox;
    RzGroupBox2: TRzGroupBox;
    RzGroupBox3: TRzGroupBox;
    btnExe: TcxButton;
    btnCancel: TcxButton;
    dtFromDate: TDateTimePicker;
    dtFromTime: TDateTimePicker;
    dtToDate: TDateTimePicker;
    dtToTime: TDateTimePicker;
    Label1: TLabel;
    Label2: TLabel;
    lvMileage: TListView;
    lstFindedCar: TListBox;
    btnToRight: TcxButton;
    RzProgressBar1: TRzProgressBar;
    btnCreateExcelFile: TcxButton;
    XLSReadWriteII1: TXLSReadWriteII;
    SaveDialog1: TSaveDialog;
    procedure btnCancelClick(Sender: TObject);
    procedure txtCarIDChange(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure lstCarListClick(Sender: TObject);
    procedure txtCarIDKeyPress(Sender: TObject; var Key: Char);
    procedure txtCarIDKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lstCarListDblClick(Sender: TObject);
    procedure btnToRightClick(Sender: TObject);
    procedure btnExeClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure lstFindedCarKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure lvMileageCustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure btnCreateExcelFileClick(Sender: TObject);
  private
    { Private declarations }
    bChange : Boolean;
  public
    { Public declarations }
    procedure FillListBox();
    procedure ShowDate();
    procedure AddMileagePart(const ACarCode:String;const AValue:Double;const AStart,AEnd:TDateTime);
    procedure AddCarMileage(const ACarCode:String;const AStart,AEnd:TDateTime);
    function CarExists(const ACarCode:String):Boolean;
    procedure CopyToRight(const AContinue:Boolean);
  end;

var
  FrmMileageStat: TFrmMileageStat;

implementation

{$R *.dfm}

procedure TFrmMileageStat.btnCancelClick(Sender: TObject);
begin
  Close();
end;

procedure TFrmMileageStat.FillListBox;
var
  i:integer;
  CarInfo:TCarInfo;
begin
  lstCarList.Clear();
  if Assigned(gCarInfoList) then
  begin
    for i := 0 to gCarInfoList.Count -1 do
    begin
      CarInfo := TCarInfo(gCarInfoList.Objects[i]);
      if Assigned(CarInfo) then
      begin
        lstCarList.Items.Add(CarInfo.VehicleRegistrationNO);
      end;
    end;
  end;
end;

procedure TFrmMileageStat.txtCarIDChange(Sender: TObject);
var
  i:integer;
  CarInfo:TCarInfo;
  s:String;
begin
  if not bChange then Exit; 
  lstCarList.Clear();
  if txtCarID.Text = '' then
  begin
    FillListBox();
    Exit;
  end;
  s := txtCarID.Text;
  for i := 0 to gCarInfoList.Count -1 do
  begin
    CarInfo := TCarInfo(gCarInfoList.Objects[i]);
    if Assigned(CarInfo) then
    begin
      if Pos(UpperCase(s),UpperCase(CarInfo.VehicleRegistrationNO)) <> 0 then
        lstCarList.Items.Add(CarInfo.VehicleRegistrationNO);
    end;
  end;
end;

procedure TFrmMileageStat.FormShow(Sender: TObject);
begin
  FillListBox();
  ShowDate();
end;

procedure TFrmMileageStat.ShowDate;
begin
  dtFromDate.Date := DateOf(Now);
  dtFromTime.Time := StrToTime('00:00:01');
  dtToDate.Date   := DateOf(Now);
  dtToTime.Time   := StrToTime('23:59:59');
end;

procedure TFrmMileageStat.AddMileagePart(const ACarCode:String;const AValue: Double;
  const AStart, AEnd: TDateTime);
const
  DATA = 1;
var
  Item:TListItem;
begin
  Item := lvMileage.Items.Add();
  Item.Caption := ACarCode;
  Item.SubItems.Add(IntToStr(lvMileage.Items.Count));
  Item.SubItems.Add(IntToStr(Round((AValue * DATA) / 1000)));
  if (AStart = 0) or (AEnd = 0) then
    Item.SubItems.Add('无')
  else
    Item.SubItems.Add(DateTimeToStr(AStart) + '-->' + DateTimeToStr(AEnd));
end;

procedure TFrmMileageStat.lstCarListClick(Sender: TObject);
var
  i:Integer;
  s:String;
begin
  bChange := False;
  for i := 0 to lstCarList.Count -1 do
  begin
    if lstCarList.Selected[i] then
    begin
      s := lstCarList.Items[i];
      break;
    end;
  end;
  txtCarID.Text := s;
end;

procedure TFrmMileageStat.txtCarIDKeyPress(Sender: TObject; var Key: Char);
begin
  bChange := True;
end;

procedure TFrmMileageStat.txtCarIDKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  bChange := True;
end;

procedure TFrmMileageStat.AddCarMileage(const ACarCode: String;
  const AStart, AEnd: TDateTime);
const
  SELECTSTR = 'SELECT * FROM CustomerMileage WHERE FCarCode=%s and FDateTime >= %s and FDateTime <= %s ORDER BY FDateTime';
var
  sCmd,sCarCode,sDateStart,sDateEnd:String;
  fTotal, fCurrent,fLast:Double;
  dtStart,dtEnd:TDateTime;
  bCanAdd:Boolean;
begin
  dtEnd       := 0;
  sCarCode    := ACarCode;
  sDateStart  := DateTimeToStr(AStart);
  sDateEnd    := DateTimeToStr(AEnd);
  DataModule1.cdsCustomer.Close();
  sCmd := Format(SELECTSTR,[QuotedStr(sCarCode),QuotedStr(sDateStart),QuotedStr(sDateEnd)]);
  bCanAdd := False;
  with DataModule1 do
  begin
    try
      Cursor := crHourGlass;
      cdsCustomer.CommandText := sCmd;
      cdsCustomer.Open();
      //获取的记录是按升序排列.
      fTotal    := 0.0;
      fLast     := 0.0;
      cdsCustomer.First();
      dtStart := cdsCustomer.FieldByName('FDateTime').AsDateTime;
      while not cdsCustomer.Eof do
      begin
        fCurrent := cdsCustomer.FieldByName('FMileageValue').AsFloat;
        if fCurrent >= fLast then
        begin
          if (fLast <> 0.0) or bCanAdd then
            fTotal := fTotal + fCurrent - fLast;
          dtEnd := cdsCustomer.FieldByName('FDateTime').AsDateTime;
        end
        else
        begin
          //如果数据发生跳跃
          bCanAdd := True;
          AddMileagePart(ACarCode,fTotal,dtStart,dtEnd);
          fTotal := 0.0 + fCurrent;
          dtStart := cdsCustomer.FieldByName('FDateTime').AsDateTime;
        end;
        fLast := fCurrent;
        cdsCustomer.Next;
      end;
      //循环完了,还有最后一段
      AddMileagePart(ACarCode,fTotal,dtStart,dtEnd);
    finally
      cdsCustomer.Close();
      Cursor := crDefault;
    end;
  end;
end;

function TFrmMileageStat.CarExists(const ACarCode: String): Boolean;
var
  i:Integer;
begin
  Result := False;
  for i := 0 to lstFindedCar.Count -1 do
  begin
    if lstFindedCar.Items[i] = ACarCode then
    begin
      Result := True;
      Exit;
    end;
  end;
end;

procedure TFrmMileageStat.lstCarListDblClick(Sender: TObject);
begin
  CopyToRight(False);
end;

procedure TFrmMileageStat.btnToRightClick(Sender: TObject);
begin
  CopyToRight(True);
end;

procedure TFrmMileageStat.btnExeClick(Sender: TObject);
var
  i:Integer;
  sCarCode:String;
  dtStart,dtEnd:TDateTime;
begin
  lvMileage.Clear;
  dtStart := StrToDateTime(DateToStr(dtFromDate.Date) + ' ' + TimeToStr(dtFromTime.Time));
  dtEnd   := StrToDateTime(DateToStr(dtToDate.Date) + ' '  + TimeToStr(dtToTime.Time));
  RzProgressBar1.Percent := 0;              
  for i := 0 to lstFindedCar.Count -1 do
  begin
    sCarCode := lstFindedCar.Items[i];
    AddCarMileage(sCarCode,dtStart,dtEnd);
    RzProgressBar1.Percent := (i + 1) * 100 div lstFindedCar.Count;
    RzProgressBar1.Update();
    Application.ProcessMessages();
  end;
  RzProgressBar1.Percent := 100;
end;

procedure TFrmMileageStat.CopyToRight(const AContinue: Boolean);
var
  i:Integer;
  sCarCode:String;
begin
  for i := 0 to lstCarList.Count -1 do
  begin
    if lstCarList.Selected[i] then
    begin
      sCarCode := lstCarList.Items[i];
      if not CarExists(sCarCode) then
      begin
        lstFindedCar.Items.Add(sCarCode);
        if not AContinue then exit; 
      end;
    end;
  end;
end;

procedure TFrmMileageStat.FormResize(Sender: TObject);
begin
  btnToRight.Top := lstCarList.Top + lstCarList.Height + 6;
  RzProgressBar1.Top := lvMileage.Top + lvMileage.Height + 4;
end;

procedure TFrmMileageStat.lstFindedCarKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if Key = 46 then //delete
    lstFindedCar.DeleteSelected();
end;

procedure TFrmMileageStat.lvMileageCustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  if (Item.Index mod 2) = 0 then
    lvMileage.Canvas.Brush.Color := clSkyBlue
  else
    lvMileage.Canvas.Brush.Color := clInfoBk;
end;

procedure TFrmMileageStat.btnCreateExcelFileClick(Sender: TObject);
var
  sFileName:String;
  i:Integer;
  Item:TListItem;
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] := '段ID' ;
    XLSReadWriteII1.Sheets[0].AsWideString[2,0] := '里程数';
    XLSReadWriteII1.Sheets[0].AsWideString[3,0] := '时间段';
    for i := 0 to lvMileage.Items.Count -1 do
    begin
      Item := lvMileage.Items[i];
      XLSReadWriteII1.Sheets[0].AsWideString[0,i + 1] := Item.Caption;
      XLSReadWriteII1.Sheets[0].AsWideString[1,i + 1] := Item.SubItems[0];
      XLSReadWriteII1.Sheets[0].AsWideString[2,i + 1] := Item.SubItems[1] + '公里';
      XLSReadWriteII1.Sheets[0].AsWideString[3,i + 1] := Item.SubItems[2];      
    end;
    XLSReadWriteII1.FileName:= sFileName;
    XLSReadWriteII1.Write;
    MessageBox(Handle,PChar('导出完毕!'),PChar('导出'),MB_OK);
  end;
end;

end.

⌨️ 快捷键说明

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