test1.pas

这是一个股票盘后数据分析系统基础底层,已经实现了基本的K线图的重现,RIS线,均线图的重现, 是在一个台湾高手发布的原码上修改的,现在支持通达信的股票数据格式.

unit Test1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, Buttons, ExtCtrls, IdBaseComponent,
  IdAntiFreezeBase, IdAntiFreeze, ComCtrls;

type

  TStockRec = record
    TheDate: string;
    OpenValue: string;
    CloseValue: string;
    TopValue: string;
    LowValue: string;
    DealValue: string;
    YestodayValue: string;
  end;

type
  TForm1 = class(TForm)
    OpenDialog1: TOpenDialog;
    ScrollBox1: TScrollBox;
    IdAntiFreeze1: TIdAntiFreeze;
    StatusBar1: TStatusBar;
    Image1: TImage;
    Memo1: TMemo;
    GroupBox1: TGroupBox;
    Button1: TButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    BitBtn3: TBitBtn;
    procedure Button1Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    DatSet: array of Integer;
    Len, TotalLen: Integer;
    DateSet: array of TStockRec;

    procedure ReadDate();
    procedure DrawCandle(BeginPoint, EndPoint, TopPoint, LowPoint: TPoint; TheColor: TColor);
  public
    { Public declarations }
  end;

var
  Form1   : TForm1;
  Opoint  : TPoint;
implementation

{$R *.dfm}

function TurnPoint(X, Y: real): TPoint;
begin
  Result.X := trunc(X) - Opoint.X;
  Result.Y := Opoint.Y - trunc(Y);
end;

function HexStrToInt(const S: string): Integer;
var
  E       : Integer;
begin
  Val('$' + S, Result, E);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  iFileHandle: Integer;
  iFileLength: Integer;
  iBytesRead: Integer;
  Buffer  : PChar;
  i       : Integer;
begin
  if OpenDialog1.Execute then
  begin
    try
      iFileHandle := FileOpen(OpenDialog1.FileName, fmOpenRead);
      iFileLength := FileSeek(iFileHandle, 0, 2);
      FileSeek(iFileHandle, 0, 0);
      Buffer := PChar(AllocMem(iFileLength + 1));
      iBytesRead := FileRead(iFileHandle, Buffer^, iFileLength);
      i := 0;
      TotalLen := iBytesRead;
      SetLength(DatSet, iBytesRead);
      SetLength(DateSet, Round(iBytesRead / 32));
      Len := Round(iBytesRead / 32);
      FileClose(iFileHandle);
      for i := 0 to iBytesRead - 1 do
      begin
        DatSet[i] := (Integer(Buffer[i]));
      end;
      ShowMessage('数据装入成功');
    finally
      FreeMem(Buffer);
    end;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i       : Integer;
begin
  ReadDate;
end;

procedure TForm1.ReadDate;
var
  i, J, K : Integer;
  str1, str2, str3, str4: string;
  TheDate : string;
  OpenValue: Integer;
  CloseValue: Integer;
  TopValue: Integer;
  LowValue: Integer;
  DealValue: Integer;
  DealCost: Integer;
  DealCost2: Integer;
begin
  i := 0;
  K := 0;
  while i < TotalLen do
  begin
    J := i;
    while J < i + 4 do
    begin
      if (J - i = 0) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 1) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 2) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 3) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    TheDate := IntToStr(HexStrToInt(str1 + str2 + str3 + str4));
    while J < i + 8 do
    begin
      if (J - i = 4) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 5) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 6) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 7) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    OpenValue := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 12 do
    begin
      if (J - i = 8) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 9) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 10) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 11) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    TopValue := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 16 do
    begin
      if (J - i = 12) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 13) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 14) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 15) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    LowValue := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 20 do
    begin
      if (J - i = 16) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 17) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 18) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 19) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    CloseValue := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 24 do
    begin
      if (J - i = 20) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 21) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 22) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 23) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    DealCost := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 28 do
    begin
      if (J - i = 24) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 25) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 26) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 27) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    DealValue := HexStrToInt(str1 + str2 + str3 + str4);
    while J < i + 32 do
    begin
      if (J - i = 28) then
      begin
        str4 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 29) then
      begin
        str3 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 30) then
      begin
        str2 := IntToHex(DatSet[J], 2);
      end;
      if (J - i = 31) then
      begin
        str1 := IntToHex(DatSet[J], 2);
      end;
      J := J + 1;
    end;
    DealCost2 := HexStrToInt(str1 + str2 + str3 + str4);
    DateSet[K].TheDate := TheDate;
    DateSet[K].OpenValue := FloatToStr(OpenValue / 100);
    DateSet[K].CloseValue := FloatToStr(CloseValue / 100);
    DateSet[K].TopValue := FloatToStr(TopValue / 100);
    DateSet[K].LowValue := FloatToStr(LowValue / 100);
    DateSet[K].DealValue := FloatToStr(DealValue);
    DateSet[K].YestodayValue := FloatToStr(DealCost2 / 100);
    i := i + 32;
    K := K + 1;
  end;
  ShowMessage('读取完成');
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
var
  i       : Integer;
  OpenValue, CloseValue, TopValue, LowValue: real;
  J       : Integer;
  Point1, Point2, Point3, Point4: TPoint;
begin
  Memo1.Clear;
  for i := 0 to Len - 1 do
  begin
    OpenValue := StrToFloat(DateSet[i].OpenValue);
    CloseValue := StrToFloat(DateSet[i].CloseValue);
    TopValue := StrToFloat(DateSet[i].TopValue);
    LowValue := StrToFloat(DateSet[i].LowValue);
    J := i * 10;
    Point1 := TurnPoint(J, OpenValue);
    Point2 := TurnPoint(J, CloseValue);
    Point3 := TurnPoint(J, TopValue);
    Point4 := TurnPoint(J, LowValue);

    Memo1.Lines.Add('起点: X:' + IntToStr(Point1.X) + ' Y: ' + IntToStr(Point1.Y)
      + ' 终点: X: ' + IntToStr(Point2.X) + ' Y: ' + IntToStr(Point2.Y)
      + ' 最高点: X: ' + IntToStr(Point3.X) + ' Y: ' + IntToStr(Point3.Y)
      + ' 最低点: X: ' + IntToStr(Point4.X) + ' Y: ' + IntToStr(Point4.Y));
    if (OpenValue < CloseValue) then
    begin
      DrawCandle(
        TurnPoint(J, OpenValue * 17),
        TurnPoint(J + 10, CloseValue * 17),
        TurnPoint(J + 5, TopValue * 17),
        TurnPoint(J + 5, LowValue * 17),
        clred);
    end
    else
      if (StrToFloat(DateSet[i].OpenValue) > StrToFloat(DateSet[i].CloseValue)) then
      begin
        DrawCandle(
          TurnPoint(J, OpenValue * 17),
          TurnPoint(J + 10, CloseValue * 17),
          TurnPoint(J + 5, TopValue * 17),
          TurnPoint(J + 5, LowValue * 17),
          clgreen);
      end
      else
      begin
        if (StrToFloat(DateSet[i].OpenValue) = StrToFloat(DateSet[i].CloseValue)) then
        begin
          DrawCandle(
            TurnPoint(J, OpenValue * 17),
            TurnPoint(J + 10, CloseValue * 17),
            TurnPoint(J + 5, TopValue * 17),
            TurnPoint(J + 5, LowValue * 17),
            clyellow);
        end;
      end;
  end;
end;

procedure TForm1.DrawCandle(BeginPoint, EndPoint, TopPoint, LowPoint: TPoint; TheColor: TColor);
begin
  Image1.Canvas.MoveTo(BeginPoint.X, BeginPoint.Y);
  Image1.Canvas.Brush.Color := clwhite;
  Image1.Canvas.Pen.Color := clwhite;
  Image1.Canvas.FillRect(rect(BeginPoint.X, BeginPoint.Y, EndPoint.X, EndPoint.Y));
  Image1.Canvas.MoveTo(TopPoint.X, TopPoint.Y);
  Image1.Canvas.LineTo(LowPoint.X, LowPoint.Y);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Opoint.X := trunc(0);
  Opoint.Y := trunc(Image1.Height);
  self.DoubleBuffered := True;
  Image1.Canvas.MoveTo(0, Opoint.Y);
  Image1.Canvas.Brush.Color := clred;
  Image1.Canvas.Pen.Color := clred;
  Image1.Canvas.Pen.Width := 1;
  Image1.Canvas.LineTo(Image1.Width, Opoint.Y);
  Image1.Canvas.MoveTo(Opoint.X, 0);
  Image1.Canvas.LineTo(Opoint.X, Image1.Height);
  Image1.Canvas.Brush.Color := clblack;
  Image1.Canvas.Rectangle(0, 0, Image1.Width, Image1.Height);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
var
  NowPoint: TPoint;
begin
  NowPoint := TurnPoint(X, Y);
  StatusBar1.Panels[1].Text := FloatToStr(NowPoint.X);
  StatusBar1.Panels[3].Text := FloatToStr(NowPoint.Y);
end;

end.