fmain2.pas

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

unit fMain2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, StdCtrls, Menus, fDef, ExtCtrls, cxGraphics, cxControls,
  cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, DBGridEh,
  DB, ADODB;

const
  MAC     : array[0..5] of Integer = (5, 10, 30, 60, 120, 240);
  VMAC    : array[0..2] of Integer = (5, 10, 30);
  RSIC    : array[0..1] of Integer = (5, 10);
  MDAC    : array[0..1] of Integer = (12, 26);

type
  { TVertLine }
  TVertLine = class(TGraphicControl)
  private
    FVisible: Boolean;
  protected
    FPosition: Integer;
    procedure SetPosition(const Value: Integer);
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Position: Integer read FPosition write SetPosition;
  end;
type
  { TVertLine }
  THorztLine = class(TGraphicControl)
  private
    FVisible: Boolean;
  protected
    FPosition: Integer;
    procedure SetPosition(const Value: Integer);
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    property Position: Integer read FPosition write SetPosition;
  end;
  { TfrmMain2 }
  TfrmMain2 = class(TForm)
    GRID: TStringGrid;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    mi100: TMenuItem;
    mi101: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    Header: TStringGrid;
    miLeftOne: TMenuItem;
    miRightOne: TMenuItem;
    miPageLast: TMenuItem;
    miPageFirst: TMenuItem;
    miFirst: TMenuItem;
    miLast: TMenuItem;
    miQuickLeft: TMenuItem;
    miQuickRight: TMenuItem;
    miSizing: TMenuItem;
    N2: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    N11: TMenuItem;
    N12: TMenuItem;
    miShowKLineHighLow: TMenuItem;
    N13: TMenuItem;
    N14: TMenuItem;
    MDAC1: TMenuItem;
    MDAC2: TMenuItem;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    Edit1: TcxTextEdit;
    DBGridEh2: TDBGridEh;
    InfoQuery: TADOQuery;
    DataSource2: TDataSource;
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure GRIDDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure mi100Click(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure mi0Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure HeaderDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure N3Click(Sender: TObject);
    procedure miPageLastClick(Sender: TObject);
    procedure miLeftOneClick(Sender: TObject);
    procedure miRightOneClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure FormActivate(Sender: TObject);
    procedure miPageFirstClick(Sender: TObject);
    procedure miFirstClick(Sender: TObject);
    procedure miLastClick(Sender: TObject);
    procedure miQuickLeftClick(Sender: TObject);
    procedure miQuickRightClick(Sender: TObject);
    procedure N11Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure MDAC1Click(Sender: TObject);
    procedure MDAC2Click(Sender: TObject);
    procedure Edit1PropertiesChange(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    FDataIndex: Integer;
    function GetDataPerPage: Integer;
    procedure SetDataIndex(Value: Integer);
  protected
    VertLine: TVertLine;
    HorztLine: THorztLine;
    ScaleHigh: array[0..3] of Single;
    ScaleLow: array[0..3] of Single;
    MA: array[0..5] of TArrayOfSingle;
    VMA: array[0..2] of TArrayOfSingle;
    RSI: array[0..1] of TArrayOfSingle;
    MDAC: array[0..3] of TArrayOfSingle;
    FStockName: string;
    FPageStart: Integer;
    FUnitWidth: Integer;
    procedure CalcMA;
    procedure CalcVMA;
    procedure CalcRSI;
    procedure DrawK(C: TCanvas; R: TRect); overload;
    procedure DrawV(C: TCanvas; R: TRect); overload;
    procedure DrawRSI(C: TCanvas; R: TRect); overload;
    procedure DrawMDAC(C: TCanvas; R: TRect); overload;
    procedure DrawScaleK(C: TCanvas; R: TRect);
    procedure DrawScaleV(C: TCanvas; R: TRect);
    procedure DrawLine(A: TArrayOfSingle; Color: TColor; C: TCanvas; R: TRect; High, Low: Single);
    procedure SetStockName(const Value: string);
    procedure SetPageStart(Value: Integer);
    procedure SetUnitWidth(Value: Integer);
    procedure CalcAll;
    function FindKLineScaleHighLow(DataFile: IDataFile; var High, Low: Single;
      var HA, LA: TArrayOfSingle; var HIndex, LIndex: TArrayOfInteger): Boolean;
    function FindVLineScaleHighLow(DataFile: IDataFile; var High, Low: Single): Boolean;
    function PageIndex2DataIndex(Index: Integer): Integer;
    procedure DRAW_DATE_SCALE(C: TCanvas; R: TRect; ShowText: Boolean);
    procedure ITERATE_DATA(Index: Integer);
    procedure MOVE_VERTLINE(DataIndex: Integer); overload;
    function DataIndexToPixel(DataIndex: Integer): Integer;
    function PixelToDataIndex(X: Integer): Integer;
    procedure CLEAR_ALL_CALCULATE_DATA();
    procedure CalaMDAC;
    function _CalaDIF_(EMA12, EMA26: TArrayOfSingle): TArrayOfSingle;
  public
    StkDataFile: IDataFile;
    SName, SID: string;
    function Fy2Iy(FY: Single; R: TRect; ScaleHigh, ScaleLow: Single): Integer;
    property StockName: string read FStockName write SetStockName;
    property PageStart: Integer read FPageStart write SetPageStart;
    property UnitWidth: Integer read FUnitWidth write SetUnitWidth;
    property DataPerPage: Integer read GetDataPerPage;
    property DataIndex: Integer read FDataIndex write SetDataIndex;
  end;

var
  frmMain2: TfrmMain2;

implementation

{$R *.dfm}

uses Math, fUtils, UCommon;

procedure TfrmMain2.FormCreate(Sender: TObject);
begin
  IS_FRACTION_UNDERLINE := True;
  //画线类
  Self.DoubleBuffered := True;
  VertLine := TVertLine.Create(Self);
  HorztLine := THorztLine.Create(Self);
  WindowState := wsMaximized;
  FPageStart := 0;
  FDataIndex := 0;
  FUnitWidth := 6;
  GRID.Color := clBlack;
  //Self.CalaMDAC;

  //K线表头
  Header.Options := Header.Options - [goVertLine, goHorzLine];
  Header.Color := clBlack;
  Header.Cells[2, 0] := '''开盘';
  Header.Cells[4, 0] := '''最高';
  Header.Cells[6, 0] := '''最低';
  Header.Cells[8, 0] := '''收盘';
  Header.Cells[10, 0] := '''涨跌';
  Header.Cells[12, 0] := '''成交量';
end;

procedure TfrmMain2.FormResize(Sender: TObject);
const
  WWW     : array[0..13] of Single = (4, 5, 2.5, 3.5, 2.5, 3.5, 2.5, 3.5, 2.5, 3.5, 2.5, 3.5, 3.5, 3.5);
var
  I, Temp : Integer;
  w, h    : Single;
  R       : TRect;
begin
  w := Round(GRID.ClientWidth * 19 / 20);

  GRID.ColWidths[1] := Max(24, Round(GRID.ClientWidth - w));
  GRID.ColWidths[0] := GRID.ClientWidth - GRID.ColWidths[1];

  h := (GRID.ClientHeight - 24) / 24;
  GRID.RowHeights[0] := 24;
  GRID.RowHeights[1] := Round(h * 12);
  GRID.RowHeights[2] := Round(h * 6);
  GRID.RowHeights[3] := Round(h * 6);
  R := GRID.CellRect(0, 0);
  InflateRect(R, -1, -1);

  Header.BoundsRect := R;
  Header.Font.Height := Header.ClientHeight - 4;
  for I := 0 to Header.ColCount - 1 do
    Header.ColWidths[I] := Round((Header.Font.Height + 3) * WWW[I]);

  if (VertLine <> nil) and (VertLine.Visible) then
  begin
    Temp := FUnitWidth;
    FUnitWidth := -1;
    UnitWidth := Temp;
  end;
end;

procedure TfrmMain2.FormShow(Sender: TObject);
begin
  if (copy(SID, 1, 3) = '000') then
  begin
    StockName := '.\Vipdoc\sz\lday\sz' + SID + '.day';
  end;
  if (copy(SID, 1, 1) = '1') then
  begin
    StockName := '.\Vipdoc\sz\lday\sz' + SID + '.day';
  end;
  if (copy(SID, 1, 1) = '3') then
  begin
    StockName := '.\Vipdoc\sz\lday\sz' + SID + '.day';
  end;
  if (copy(SID, 1, 1) = '6') then
  begin
    StockName := '.\Vipdoc\sh\lday\sh' + SID + '.day';
  end;
  if (copy(SID, 1, 1) = '9') then
  begin
    StockName := '.\Vipdoc\sh\lday\sh' + SID + '.day';
  end;
  Panel1.Top := screen.Height - Panel1.Height - 70;
  Panel1.Left := screen.Width - Panel1.Width - 10;
end;

procedure TfrmMain2.GRIDDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  C       : TCanvas;
begin
  C := GRID.Canvas;
  C.Pen.Color := clGreen;
  C.Brush.Color := GRID.Color;
  if ACol < 1 then Inc(Rect.Right);
  if ARow < 3 then Inc(Rect.Bottom);
  C.Rectangle(Rect);
  case ACol of
    0: case ARow of
        0: ;
        1: DrawK(C, Rect);
        2: DrawV(C, Rect);
        3: DrawRSI(C, Rect); //画指标
        // 3: DrawMDAC(C, Rect);
      end;
    1: case ARow of
        0: ;
        1: DrawScaleK(C, Rect);
        2: DrawScaleV(C, Rect);
        3: DRAW_SCALE(C, Rect, ArrayOdSingle([80, 50, 20]), 0, 100, 0, 100);
      end;
  end;
  if (VertLine <> nil) and VertLine.Visible then VertLine.Paint;
end;

procedure TfrmMain2.SetStockName(const Value: string);
begin
  if (StkDataFile = nil) or (Value <> FStockName) then
  begin
    FStockName := Value;
    CLEAR_ALL_CALCULATE_DATA();

    StkDataFile := TDataFile.Create(FStockName);
    if StkDataFile <> nil then
    begin
      if DataIndex > StkDataFile.getCount - 1 then
      begin
        FPageStart := StkDataFile.getCount - DataPerPage;
        FDataIndex := StkDataFile.getCount - 1;
      end;
      CalcAll;
      GRID.Repaint;

      //Header.Cells[0, 0] := Copy(FStockName, 4, Length(FStockName) - 3);
      Header.Cells[0, 0] := SName;

      MOVE_VERTLINE(DataIndex);
      ITERATE_DATA(DataIndex);
    end;
  end;
end;

procedure TfrmMain2.SetPageStart(Value: Integer);
begin
  if StkDataFile <> nil then
  begin
    Value := Max(-Max(1, DataPerPage div 8), Min(StkDataFile.getCount - DataPerPage, Value));
    if Value <> FPageStart then
    begin
      FPageStart := Value;
      GRID.Repaint;
    end;
  end;
end;

procedure TfrmMain2.SetUnitWidth(Value: Integer);
var
  NewPageStart: Integer;
begin
  Value := Max(1, Min(40, Value));
  if Value > 1 then Value := Value div 2 * 2;
  if (Value <> FUnitWidth) and (StkDataFile <> nil) then
  begin
    FUnitWidth := Value;
    NewPageStart := DataIndex - DataPerPage div 2;
    NewPageStart := Max(0, NewPageStart);
    NewPageStart := Min(NewPageStart, StkDataFile.getCount - DataPerPage);
    FPageStart := NewPageStart;
    FDataIndex := Max(FDataIndex, FPageStart);
    MOVE_VERTLINE(FDataIndex);
    ITERATE_DATA(FDataIndex);
    GRID.Repaint;
  end;
end;

function TfrmMain2._CalaDIF_(EMA12, EMA26: TArrayOfSingle): TArrayOfSingle;
var
  I       : Integer;
  Max     : Integer;
begin
  Max := (High(EMA12));
  SetLength(Result, Max);
  I := 0;
  while I < Max do
  begin
    Result[I] := EMA12[I] - EMA26[I];
    I := I + 1;
  end;
end;

procedure TfrmMain2.CalaMDAC;
var
  I, Max  : Integer;
  EMA12, EMA26, DIF9, DEA, CPset: TArrayOfSingle;
begin
  CPset := StkDataFile.getCP;
  Max := Length(CPset);
  SetLength(EMA12, Length(CPset));
  SetLength(EMA26, Length(CPset));
  SetLength(DIF9, Length(CPset));
  SetLength(DEA, Length(CPset));
  // SetLength(MDAC, Length(CPset));
  if CPset <> nil then
  begin
    EMA12 := _calcMDAC_(CPset, 12);
    EMA26 := _calcMDAC_(CPset, 26);
  end;
  DIF9 := Self._CalaDIF_(EMA12, EMA26);
  for I := 0 to Max - 1 do
  begin
    DEA[I] := DIF9[I - 1] * 8 / 10 + DIF9[I] * 2 / 10;
  end;
  for I := 0 to 3 do
  begin
    if (I = 0) then
    begin
      MDAC[I] := EMA12;
    end;
    if (I = 1) then
    begin
      MDAC[I] := EMA26;
    end;
    if (I = 2) then
    begin
      MDAC[I] := DIF9;
    end;
    if (I = 3) then
    begin
      MDAC[I] := DEA;
    end;
  end;

end;

procedure TfrmMain2.CalcAll;
begin
  CalcMA;
  CalcVMA;
  CalcRSI;
end;

function TfrmMain2.GetDataPerPage: Integer;
begin
  if FUnitWidth > 0 then
    Result := _width_(GRID.CellRect(0, 1)) div FUnitWidth
  else
    Result := 0;
end;

procedure TfrmMain2.CalcMA;
var
  I       : Integer;
begin
  for I := 0 to Length(MAC) - 1 do
    if MAC[I] = 0 then
      MA[I] := nil
    else
      MA[I] := _calcMA_(StkDataFile.getCP, MAC[I]);
end;

procedure TfrmMain2.CalcRSI;
var
  I       : Integer;
  A       : TArrayOfSingle;
begin
  A := StkDataFile.getUD;
  if A <> nil then
    for I := 0 to 1 do
      RSI[I] := _calcRSI_(A, RSIC[I]);
end;

procedure TfrmMain2.CalcVMA;
var
  I       : Integer;
begin
  for I := 0 to Length(VMAC) - 1 do
    if VMAC[I] = 0 then
      VMA[I] := nil
    else
      VMA[I] := _calcMA_(StkDataFile.getVOL, VMAC[I]);
end;

procedure TfrmMain2.DrawK(C: TCanvas; R: TRect);
var
  C3      : TColor;
  High, Low, D: Single;
  I, J, X1, X2, Y1, Y2, X3, Y3, M, N: Integer;
  P       : PStkDataRec;
  HIndex, LIndex: TArrayOfInteger; //Range 0 to DataPerPage-1.
  HA, LA  : TArrayOfSingle;
  str     : string;
  Rt      : TRect;
  TH, TW  : Integer;
begin
  HA := nil;
  LA := nil;

  if IS_SHOW_DATESCALE then DRAW_DATE_SCALE(C, R, True);

  if FindKLineScaleHighLow(StkDataFile, High, Low, HA, LA, HIndex, LIndex) then
  begin
    ScaleHigh[1] := High;
    ScaleLow[1] := Low;
    D := (High - Low) / 20;
    High := High + D;