📄 umileagestat.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 + -