rger6w456456.pas

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

unit rger6w456456;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DB, MemDS, VirtualTable, Grids, DBGridEh, fdef,
  IdBaseComponent, IdAntiFreezeBase, IdAntiFreeze, ComCtrls;

type
  TStockInfo = record
    Code: string;
    Name: string;
    ZCode: string;
  end;

type
  TForm1 = class(TForm)
    Button1: TButton;
    DBGridEh1: TDBGridEh;
    DataSource1: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    IdAntiFreeze1: TIdAntiFreeze;
    TempTable: TVirtualTable;
    TempTableStringField: TStringField;
    TempTableStringField2: TStringField;
    TempTableStringField3: TStringField;
    TempTableFloatField: TFloatField;
    TempTableFloatField2: TFloatField;
    TempTableFloatField3: TFloatField;
    TempTableFloatField4: TFloatField;
    TempTableFloatField5: TFloatField;
    TempTableFloatField6: TFloatField;
    TempTableFloatField7: TFloatField;
    TempTableFloatField8: TFloatField;
    TempTableFloatField9: TFloatField;
    TempTableField: TStringField;
    StatusBar1: TStatusBar;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure DBGridEh1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure DBGridEh1DblClick(Sender: TObject);
  private
    MySet: array of TStockInfo;
    FStockName: string;
    procedure SetStockName(const Value: string);

  public
    StkDataFile: IDataFile;
    property StockName: string read FStockName write SetStockName;
  end;

var
  Form1   : TForm1;

implementation
uses Math, fUtils, UCommon, fMain2;
{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  Head, RecSize: Word;
  ZCode, Code, Name: string;
  Buffer  : ^string;
  MS      : TMemoryStream;
  Max, I  : Integer;
  P, Q    : PStkDataRec;
begin
  Label1.Caption := DateTimeToStr(Now);
  Head := 41;
  RecSize := 250;
  MS := TMemoryStream.Create;
  MS.LoadFromFile('shex.tnf');
  MS.Position := 50;
  I := 0;
  Max := (MS.Size - 50) div 250;
  SetLength(MySet, Max);
  TempTable.Active := True;
  TempTable.Clear;
  TempTable.DisableControls;
  while MS.Position < MS.Size - 4 do
  begin
    GetMem(Buffer, MS.Size);
    TempTable.Append;
    MS.ReadBuffer(Buffer^, 6);
    Code := trim(string(Buffer));
    TempTable.FieldByName('股票代码').AsString := Copy(Code, 1, 6);
    MS.Position := MS.Position + 18;
    MS.Read(Buffer^, 8);
    Name := TrimLeft(string(Buffer));
    TempTable.FieldByName('股票名称').AsString := Copy(Name, 1, 8);
    MS.Position := MS.Position + 209;
    MS.Read(Buffer^, 4);
    ZCode := trim(string(Buffer));
    TempTable.FieldByName('助记码').AsString := Copy(ZCode, 1, 4);
    if (Copy(Code, 1, 1) = '6') then
    begin
      TempTable.FieldByName('显示标志').AsString := '1';
    end
    else
    begin
      TempTable.FieldByName('显示标志').AsString := '0';
    end;
    StockName := '.\Vipdoc\sh\lday\sh' + Copy(Code, 1, 6) + '.day';
    begin
      try
        Q := PStkDataRec(StkDataFile.getData(1));
        if Q <> nil then
        begin
          if (INtToStr(Q.CP) <> '') then
          begin
            P := PStkDataRec(StkDataFile.getData(0));
            TempTable.FieldByName('昨收').AsFloat := Q.CP / 100;
            TempTable.FieldByName('今收').AsFloat := P.CP / 100;
            TempTable.FieldByName('今开').AsFloat := P.OP / 100;
            TempTable.FieldByName('最高').AsFloat := P.HP / 100;
            TempTable.FieldByName('最低').AsFloat := P.LP / 100;
            TempTable.FieldByName('涨跌额').AsFloat := (P.CP / 100) - (Q.CP / 100);
            TempTable.FieldByName('成交量').AsFloat := P.VOL / 100;
            TempTable.FieldByName('涨幅').AsFloat := (P.CP - Q.CP) / Q.CP * 100;
          end;
        end;
      except

      end;
    end;
    MS.Position := MS.Position + 5;
    I := I + 1;
    TempTable.Post;
  end;
  // ShowMessage('读入完成!');
  TempTable.First;
  TempTable.EnableControls;
  TempTable.Filtered := False;
  TempTable.Filter := '显示标志=' + #39 + '1' + #39;
  TempTable.Filtered := True;
  Label2.Caption := DateTimeToStr(Now);
end;

procedure TForm1.SetStockName(const Value: string);
begin
  if (StkDataFile = nil) or (Value <> FStockName) then
  begin
    FStockName := Value;
    StkDataFile := TDataFile.Create(FStockName);
  end;
end;

procedure TForm1.DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
  AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if (TempTable.FieldByName('涨跌额').AsFloat > 0) then
  begin
    AFont.Color := Clred;
  end
  else
    if (TempTable.FieldByName('涨跌额').AsFloat < 0) then
    begin
      AFont.Color := $0000D200;
    end;
end;

procedure TForm1.DBGridEh1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
begin
  with (Sender as TDBGridEh).Canvas do //画 cell 的边框
  begin
    Pen.Color := clyellow; //定义画笔颜色(蓝色)
    MoveTo(Rect.Left, Rect.Bottom); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画蓝色的横线
    Pen.Color := clblack; //定义画笔颜色(绿色)
    MoveTo(Rect.Right, Rect.Top); //画笔定位
    LineTo(Rect.Right, Rect.Bottom); //画绿色的竖线
  end;
end;

procedure TForm1.DBGridEh1DblClick(Sender: TObject);
begin
  frmMain2 := TfrmMain2.Create(Self);
  frmMain2.SName := TempTable.FieldByName('股票名称').AsString;
  frmMain2.SID := TempTable.FieldByName('股票代码').AsString; 
  frmMain2.ShowModal;
end;

end.