kxianmain.~pas

该系统将温度数据以类似股票K线显示方式进行分析

unit KXianMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls, Menus, main, ADODB, DB, DateUtils,Variants, Grids,
  DBGrids, DBCtrls,kxiancommon,Printers, ExtDlgs, ComCtrls, fBatchQuery;

type
    TFormKXianMain = class(TForm)
    PaintBoxMain: TPaintBox;
    PanelMain: TPanel;
    LabelCode: TLabel;
    ADODtest: TADODataSet;
    ADOQwdjl: TADOQuery;
    ADOQbatch: TADOQuery;
    ImageSec: TImage;
    SecBatch: TEdit;
    Label1: TLabel;
    ImageWork: TImage;
    PrintDialog1: TPrintDialog;
    PrinterSetupDialog1: TPrinterSetupDialog;
    SavePictureDialog1: TSavePictureDialog;
    editcode: TEdit;
    ADODbatch: TADODataSet;
    procedure DoPrintWork();
    procedure DoPrintAll();
    procedure FormShow(Sender: TObject);
    procedure ReadData(Sender: Tobject);
    procedure ReadDataSec(Sender: Tobject);
    Procedure DrawLineInIt(Sender: Tobject);
    Procedure DrawLineInItSec(Sender: Tobject);
    Procedure EnlageLineInIt(Sender: Tobject; flag : integer);
    Procedure EnlageLineInItSec(Sender: Tobject; flag : integer);
    Procedure DrawLine(Sender: Tobject);
    Procedure DrawLineSec(Sender: Tobject);
    Procedure DrawEMPTY(Sender: Tobject);
    Procedure DrawEMPTYSec(Sender: Tobject);
    Procedure MoveLineLeft(Sender: Tobject);
    Procedure MoveLineRight(Sender: Tobject);
    Procedure MoveLineHome(Sender: Tobject);
    Procedure MoveLineHomeSec(Sender: Tobject);
    Procedure MoveLineEnd(Sender: Tobject);
    Procedure MoveLineEndSec(Sender: Tobject);
    Procedure DrawNowLine(Sender: Tobject);
    Procedure DrawNowLineSec(Sender: Tobject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditCode1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ImageworkMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImageSecMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure SecBatchKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure editcodeChange(Sender: TObject);
    procedure EDITCODEDblClick(Sender: TObject);
    procedure SecBatchDblClick(Sender: TObject);
    procedure ImageWorkDblClick(Sender: TObject);
    procedure ImageSecDblClick(Sender: TObject);
    private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FormKXianMain: TFormKXianMain;
  //公共定义
  PaintHeight,PaintWidth,TopY,BottomY: integer;
  DefaultWidth: integer;

  LineData : array of tData;
  
  MINSTEP : INTEGER; //定义处理数据的步长
  ms : array of integer;
  msi : integer;

  LeftX,RightX:Integer;
  PageTopY,PageMidY,PageLowY:Integer;
  //适用与分析的数据定义
  CurrentX,MouseX,MouseY:Integer;
  MaxJg,MinJg,DayCount:Integer;
  HeightXiShu:Double;
  CurrentCode:String;
  BeginDate,EndDate,LeftDate,RightDate,CurrentDate:Integer;

//适用于对照的数据定义
  SecCurrentX,SecDate, seCMouseX, SecMouseY :Integer;
  SecMaxJg,SecMinJg,SecDayCount:Integer;
  SecHeightXiShu:Double;
  SecCurrentCode:String;
  SecBeginDate,SecEndDate,SecLeftDate,SecRightDate :Integer;
  SecLineData:Array of tData;
  SecMinData: ARRAY OF STRING;

  tRefTimeWork, tRefTimeSec :tDateTime;
  implementation


{$R *.DFM}

//批号查找   ，batid是一个变量， 所有的批号保存在
Function batFind(Zqdm:String):Integer;
Var I:Integer;
Begin
   batFind:=-1;
   I:=0;
   While (I<batCount) Do
   Begin
      If Trim(UpperCase(batchs[I]))<>Trim(UpperCase(Zqdm)) Then
         I:=I+1
      Else
         Begin
         batFind:=I;
         batId:=I;
         Exit;
         End;
   End;
End;
// Print the Working Batch detail
procedure TFormKXianMain.DoPrintWork();
VAR strect: Trect;
var temhi,temwd:integer;
begin
if not (PrintRight =0) then   exit;
if printdialog1.execute then
   begin
        if imageWork.Height < imagework.Width then
        begin
                temwd:=trunc(int(printer.PageWidth *0.85)); //picture.width;
                temhi:=trunc(temwd * imagework.Height/imagework.Width *2);   //imageWork.picture.height;
        end
        else
        begin
                temhi:=trunc(int(printer.Pageheight *0.85)); //picture.width;
                temwd:=trunc(temhi * imagework.width/imagework.height );   //imageWork.picture.height;
        end;
        with strect do
        begin
            left:=(printer.pagewidth -temwd) div 2;
            top:=(printer.pageheight-temhi) div 2;
            right:=left+temwd;
            bottom:=top+temhi;
        end;
        with printer do
        begin
                begindoc;
                canvas.stretchdraw(strect, imageWork.picture.graphic);
                enddoc;
        end;
   end;
  IF SavePictureDialog1.Execute THEN
  IMAGEWORK.Picture.SaveToFile(SavePictureDialog1.FileName);
end;
// Print the working and the second batch detail
procedure TFormKXianMain.DoPrintAll();
VAR strect, strectsec: Trect;
var temhi,temwd:integer;
begin
if not (PrintRight =0) then     exit;
if printdialog1.execute then
   begin
        if imageWork.Height < imagework.Width then
        begin
                temwd:=trunc(int(printer.PageWidth *0.85)); //picture.width;
                temhi:=trunc(temwd * imagework.Height/imagework.Width *2 );   //imageWork.picture.height;
        end
        else
        begin
                temhi:=trunc(int(printer.Pageheight *0.85)); //picture.width;
                temwd:=trunc(temhi * imagework.width/imagework.height );   //imageWork.picture.height;
        end;
        with strect do
        begin
            left:=(printer.pagewidth -temwd) div 2;
            top:=(printer.pageheight-temhi*2) div 2;
            right:=left+temwd;
            bottom:=top+temhi ;
        end;
        with strectSec do
        begin
            left:=(printer.pagewidth -temwd) div 2;
            top:= strect.bottom +1;
            right:=left+temwd;
            bottom:=top+temHi ;
        end;

        with printer do
        begin
                begindoc;
                canvas.stretchdraw(strect,imageWork.picture.graphic);
                canvas.stretchdraw(strectSec,imageSec.picture.graphic);
                enddoc;
        end;
   end;

end;

// K线的Form显示程序，传入数据源文件名、证券信息文件名
procedure TFormKXianMain.FormShow(Sender: TObject);
var ls_str:string;
Begin
 MainForm.Visible :=FALSE;
 if tfBatchQuery.Execute(2,ls_str,'请选择待分析批号...' ) then
     Currentcode :=ls_str;
     batid:=0;  //定义当前的批号数组的位置
     PaintBoxMain.Height :=self.ClientHeight;
     PaintBoxMain.width := SELF.ClientWidth;
     PaintBoxMain.Left :=0;
     PaintBoxMain.top :=0;

     imagewORK.Left :=0;
     imageWORK.top :=0 ;
     imageWork.Height := TRUNC((SELF.ClientHeight -38)/2);
     imageWork.width := SELF.ClientWidth;

     imagesec.Height := TRUNC((SELF.ClientHeight -38)/2);
     imagesec.width := SELF.ClientWidth-1;
     imagesec.Left :=0;
     imagesec.top := ImageWork.height; //PaintBoxMain.Height ;

     setlength(ms,5) ;
     ms[0] :=2;
     ms[1] :=5;
     ms[2] :=10;
     ms[3] :=15;
     ms[4] :=30;

     msi :=1;
     minstep :=ms[msi];
     PaintHeight:=imageWork.Height;
     PaintWidth:=imageWork.width;
     DefaultWidth:=9;
     LeftX:=120;
     RightX:=50;    //120
     TopY:=20; //20; 调整该数值可以调整显示的屏幕区间
     BottomY:=20;
     DayCount:=-1;
     BeginDate:=0;
     EndDate:=0;
     LeftDate:=0;
     RightDate:=0;
     CurrentDate :=0;
     SECCURRENTcode :=' ';

     SecDayCount:=-1;
     SecBeginDate:=0;
     SecEndDate:=0;
     SecLeftDate:=0;
     SecRightDate:=0;
     SecDate :=0;
     EditCode.Left:=PaintWidth-EditCode.Width-5;
     LabelCode.Left:=EditCode.Left-LabelCode.Width-2;
     Canvas.Brush.Color:=clWhite;//clblack;
     Canvas.Brush.style:=bsSolid;
     Canvas.FillRect(Rect(0,0,PaintWidth,PaintHeight));
     ActiveControl:=EditCode;
     drawempty(editcode);
     drawemptySec(editcode);

end;

Procedure TFormKXianMain.ReadData(Sender: Tobject);
Var I,j :Integer;
Var mint, maxt, AMT,curTmp, lastTmp :INTEGER;
var begintime:tdatetime;
Begin
  //读取数据  表 wdjls,读取最大的未处理的数据的时间，设为begintime,系统数据步长minstep=2min
  with adodtest do
  begin
        //获取该控制点的最大已处理的时间，作为最小未处理时间
        CommandType := cmdText;
        CommandText :='select * from bat_detail where ' +
                       ' batchno = ' + QuotedStr(batchs[batid])+
                       ' Order by dts asc';
        OPEN ;
        //数据已经读入到recordset 中 ，初始化daydata数组
        DayCount := RecordCount;
        SetLength(LineData,DayCount);
        //开始读取数组
        FIRST;
        I :=0;

       curTmp :=round(Fields.Fields[5].AsFloat *10);
       if  CurTmp >3000  then CurTmp:=  Actors[curConId].MaxT;
       if  CurTmp <-400  then CurTmp:=  Actors[curConId].MinT;

       LastTmp := CurTmp;

        begintime := Fields.Fields[2].AsDateTime;
        WHILE  (RecNo <=RecordCount) and ( not eof)   DO
        BEGIN
             LineData[i].sActorId := Fields.Fields[0].AsString;
             LineData[i].sActorName := Fields.Fields[3].AsString;
             LineData[i].sGroupId   :=Fields.Fields[6].AsString;
             LineData[i].sGroupName := Fields.Fields[4].AsString;
             LineData[i].sBatchNo := batchs[batid];

             curTmp :=round(Fields.Fields[5].AsFloat *10);
             if  CurTmp >3000  then CurTmp:= lastTmp;
             if  CurTmp <-400  then CurTmp:= LastTmp;

             LineData[I].iOpenT:= curTmp;//OPEN
             MINT := curTmp;
             MAXT := curTmp;
             j :=0;
             AMT:=0;
             while (j <= MINSTEP -1)  AND (NOT adodtest.EOF) do
             begin
                  curTmp :=round(Fields.Fields[5].AsFloat *10);
                  if  CurTmp >3000  then CurTmp:= lastTmp;
                  if  CurTmp <-400  then CurTmp:= LastTmp;

                  IF MINT > curTmp THEN   MINT := curTmp;
                  IF MAXT < curTmp THEN   MAXT := curTmp;
                  LineData[I].iCloseT:= curTmp;   //CLOSE
                  lastTmp := CurTmp;
                  AMT := AMT +LineData[I].iCloseT;
                  j := j+1;
                  NEXT;
             end ;
             LineData[I].iMaxT:= MAXT; //High
             LineData[I].iMinT:= MINT; //Low
             LineData[i].dtDateTime := Fields.Fields[2].AsDateTime;
             LineData[I].iFlag:= minutesbetween(begintime, lINEdATA[I].dtDateTime); //存放时间
             LineData[I].iAvgT := ROUND(AMT /J);
             I :=I+1;
        END;
        close;
        DAYCOUNT := I;
  End
End;
Procedure TFormKXianMain.ReadDataSec(Sender: Tobject);
Var I,j :Integer;
Var mint, maxt ,AMT , CurTmp,lastTmp:INTEGER;
var begintime:tdatetime;
Begin
  //读取数据  表 wdjls, 读取最大的未处理的数据的时间，设为begintime
  //系统数据步长minstep=2min, 不安排F5和F6功能
  with adodtest do
  begin
        //获取该控制点的最大已处理的时间，作为最小未处理时间
        CommandType := cmdText;
        CommandText :='select * from bat_detail where ' +
                       ' batchno = ' + QuotedStr(SecCurrentcode)+
                       ' Order by dts asc';
        OPEN ;
        //数据已经读入到recordset 中 ，初始化daydata数组
        SecDayCount := RecordCount;
        SetLength(SecLineData,SecDayCount);
        //开始读取数组
        FIRST;
        I :=0;

        curTmp :=round(Fields.Fields[5].AsFloat *10);
        if  CurTmp >3000  then CurTmp:=  Actors[curConId].MaxT;
        if  CurTmp <-400  then CurTmp:=  Actors[curConId].MinT;

        LastTmp := CurTmp;

        Begintime := Fields.Fields[2].AsDateTime;
        WHILE  (RecNo <=RecordCount) and ( not eof)   DO
        BEGIN
             SecLineData[i].sActorId := Fields.Fields[0].AsString;
             SecLineData[i].sActorName := Fields.Fields[3].AsString;
             SecLineData[i].sGroupId :=Fields.Fields[6].AsString;
             SecLineData[i].sGroupName := Fields.Fields[4].AsString;