datacurveformunit.pas

delphi开发的抄表数据管理系统

unit DataCurveFormUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DBCtrls, StdCtrls, Grids, DBGrids, ComCtrls, ExtCtrls, Spin,
  ToolWin, Buttons, jpeg, TeeProcs, TeEngine, Chart, DbChart, Series, DB,
  ADODB, strutils, dateutils;

type
  TDataCurveForm = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Panel2: TPanel;
    Panel1: TPanel;
    Splitter1: TSplitter;
    PageControl2: TPageControl;
    TabSheetCurve: TTabSheet;
    PageControl4: TPageControl;
    TabSheet9: TTabSheet;
    DBGrid1: TDBGrid;
    Panel25: TPanel;
    EditPos: TEdit;
    Label20: TLabel;
    Label21: TLabel;
    DateTimePicker1: TDateTimePicker;
    DateTimePicker2: TDateTimePicker;
    ButtonRefresh: TButton;
    ToolBar13: TToolBar;
    ToolButton16: TToolButton;
    ToolButtonExport: TToolButton;
    TabSheetData: TTabSheet;
    Chart1: TChart;
    Series1: TLineSeries;
    DataSource1: TDataSource;
    ADOQueryCurve: TADOQuery;
    EditNo: TEdit;
    ListView1: TListView;
    ADOQuery1: TADOQuery;
    ToolButtonMarks: TToolButton;
    CheckBoxNo: TCheckBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure ButtonRefreshClick(Sender: TObject);
    procedure ADOQueryCurveAfterScroll(DataSet: TDataSet);
    procedure ToolButtonMarksClick(Sender: TObject);

  private
    { Private declarations }
    function TranslateCurveData(ctime:string; cdata:string; jsl:double):boolean;

  public
    { Public declarations }
  end;

var
  DataCurveForm: TDataCurveForm;
  curvetimearray : array[1..912] of string;
  curvedataarray : array[1..912] of double;
  curvepointcount : integer;

implementation

uses DataModuleUnit1;

{$R *.dfm}

procedure TDataCurveForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
    DataModule1.ADOConnection1.Close;
    DataCurveForm:=nil;
    action:=cafree;
end;

procedure TDataCurveForm.FormCreate(Sender: TObject);
begin
    left := 0;
    top := 0;
    datetimepicker1.Date := dateof(incmonth(now,-1));
    datetimepicker2.Date := dateof(now);
    datetimepicker1.Checked := true;
    datetimepicker2.Checked := false;
end;

procedure TDataCurveForm.ButtonRefreshClick(Sender: TObject);
var
    sql : string;
begin
    listview1.Items.Clear;
    Series1.Clear;

    sql := 'select 设备上传时间,用户名称,注册号,曲线开始时间,设备类型,设备ID号,地址,区号,本号 from 曲线数据视图 where ';
    if (length(trim(editNo.Text))<>0) and checkboxno.Checked then
        sql := sql + ' 注册号=''' + trim(editNo.Text) + ''' and ';
    if datetimepicker1.checked then
        sql := sql + ' 设备上传时间 >= ''' + formatdatetime('yyyy-mm-dd',datetimepicker1.date)+''' and ';
    if datetimepicker2.Checked then
        sql := sql + ' 设备上传时间 <= ''' + formatdatetime('yyyy-mm-dd',datetimepicker2.date)+' 23:59:59'' and ';
    sql := sql + ' 1=1';

    ADOQueryCurve.Connection :=datamodule1.ADOConnection1;
    ADOQueryCurve.SQL.Clear;
    ADOQueryCurve.Filtered:=false;
    ADOQueryCurve.Close;
    ADOQueryCurve.SQL.Add(sql);
    ADOQueryCurve.Prepared;
    ADOQueryCurve.Open;
end;

procedure TDataCurveForm.ADOQueryCurveAfterScroll(DataSet: TDataSet);
var
    lvitem:tlistitem;
    i:integer;
    sql,s1,s2 : string;
begin
    try
        if adoquerycurve.RecordCount = 0 then exit;

         editpos.Text:='位置: '+
            inttostr(adoquerycurve.RecNo)+'/'+
            inttostr(adoquerycurve.RecordCount);

        s1 := AdoQueryCurve.fieldbyname('注册号').AsString;
        s2 := AdoQueryCurve.fieldbyname('设备上传时间').AsString;

        editno.Text := s1;

        sql := 'SELECT a.曲线开始时间, a.曲线数据, b.计数轮, b.注册号' +
             ' FROM 曲线数据表 AS a INNER JOIN 当前数据表 AS b  ON a.注册号 = b.注册号' +
             ' WHERE (a.注册号 = '''+s1+''') AND (a.设备上传时间 = '''+s2+''')';

        adoquery1.Connection := datamodule1.ADOConnection1;
        adoquery1.SQL.Clear;
        adoquery1.Filtered:=false;
        adoquery1.Close;
        adoquery1.SQL.Add(sql);
        adoquery1.Prepared;
        adoquery1.open;

        if  (adoquery1.FieldValues['计数轮']=0) or
            (length(adoquery1.FieldValues['曲线数据'])=0) or
            (adoquery1.RecordCount=0) then
        begin
            application.MessageBox('没有可供使用的数据！','确定',mb_iconinformation);
            exit;
        end;

        screen.Cursor:=crHourGlass;

        TranslateCurveData(
            adoquery1.FieldValues['曲线开始时间'],
            adoquery1.FieldValues['曲线数据'],
            adoquery1.FieldValues['计数轮']);

        listview1.Items.Clear;
        Series1.Clear;
        for i := 1 to curvepointcount do
        begin
            lvitem := listview1.Items.Add;
            lvitem.Caption := curvetimearray[i];
            lvitem.SubItems.Add(currtostr(curvedataarray[i]));
            Series1.Add(curvedataarray[i], curvetimearray[i], clBlue );
        end;
        
        screen.Cursor:=crDefault;

    except
    on e:exception do
        begin
             screen.Cursor:=crDefault;
        end;
    end;
end;


function TDataCurveForm.TranslateCurveData(ctime:string; cdata:string; jsl:double):boolean;
var
    i, k : integer;
    dt : tdatetime;
    s : string;
    val : currency;
begin
    try
        curvepointcount := length(cdata) div 4;

        if length(ctime) > 10 then
            ctime := leftstr(ctime, 10)+' '+rightstr(ctime, 2)+':00:00';
        dt := strtodatetime(ctime);

        for i:= 0 to curvepointcount-1 do
        begin
            s := midstr(cdata, i*4+1, 4);
            k := strtoint('$' + s);
            val := k * jsl * 5;
            k := curvepointcount - i;
            curvedataarray[k] := val;
            //
            if length(ctime) > 10 then
            begin
                s := formatdatetime('yyy-mm-dd hh:nn', dt);
                curvetimearray[k] :=  s;
                dt := inchour(dt, -1);
            end
            else
            begin
                s := formatdatetime('yyy-mm-dd', dt);
                curvetimearray[k] := s;
                dt := incday(dt, -1);
            end;
        end;

        result := true;

    except
        on e:exception do
        begin
            result := false;
        end;
    end;
end;


procedure TDataCurveForm.ToolButtonMarksClick(Sender: TObject);
begin
    if toolbuttonmarks.Down then
        series1.Marks.Visible := true
    else
       series1.Marks.Visible := false;
end;

end.