fmain2.pas

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

    Low := Low - D * 2;
    InflateRect(R, 0, -2);
    if ShowBackgroundDotLine then
      DRAW_HORZ_SCALE(C, R, ScaleLow[1], ScaleHigh[1], Low, High, _height_(R) div 25, True);

    if miShowKLineHighLow.Checked and (Length(HIndex) > 0) then
    begin
      C.Font.Name := '宋体';
      C.Font.Height := Max(2, Round(_height_(R) * 0.05) - 1);
      C.Pen.Color := GRID.Color;
      for I := 0 to Length(HIndex) - 1 do
      begin
        str := _vs_(HA[HIndex[I]]);
        TW := C.TextWidth(str);
        TH := C.TextHeight(str);
        X1 := 1 + UnitWidth * HIndex[I] - TW div 2 + UnitWidth div 2 - 1;
        Y1 := Fy2Iy(HA[HIndex[I]], R, High, Low) - TH + 1;
        Rt := Rect(X1, Y1, X1 + TW, Y1 + TH);
        Rt.Left := Min(R.Right - TW - 1, Max(Rt.Left, 1));
        Rt.Right := Rt.Left + TW + 2;
        if not IS_FRACTION_UNDERLINE then
          _textRectBackground_(C, Rt, str, C.Font.Height, clRed or $008000, GRID.Color, taCenter, tlTop, True)
        else
          _textRect_(C, Rt, str, clRed or $008000, GRID.Color, taCenter, tlTop, False); //这里标出最高的的交易K线
      end;
    end;

    if miShowKLineHighLow.Checked and (Length(LIndex) > 0) then
    begin
      C.Font.Name := '宋体';
      C.Font.Height := Max(2, Round(_height_(R) * 0.05) - 1);
      C.Pen.Color := GRID.Color;
      for I := 0 to Length(LIndex) - 1 do
      begin
        str := _vs_(LA[LIndex[I]]);
        TW := C.TextWidth(str);
        TH := C.TextHeight(str);
        X1 := 1 + UnitWidth * LIndex[I] - TW div 2 + UnitWidth div 2 - 1;
        Y1 := Fy2Iy(LA[LIndex[I]], R, High, Low) + 1;
        Rt := Rect(X1, Y1, X1 + TW, Y1 + TH);
        Rt.Left := Min(R.Right - TW - 1, Max(Rt.Left, 1));
        Rt.Right := Rt.Left + TW + 2;
        if not IS_FRACTION_UNDERLINE then
          _textRectBackground_(C, Rt, str, C.Font.Height, clAqua and $C0C0C0, GRID.Color, taCenter, tlTop, True)
        else
          _textRect_(C, Rt, str, clAqua and $C0C0C0, GRID.Color, taCenter, tlTop, False); //这里是标出最低的交易K线
      end;
    end;

    _setPen_(C, GRID.Color, 1, psSolid, pmCopy);
    _setBrush_(C, GRID.Color, bsSolid);
    for I := 0 to DataPerPage - 1 do
    begin
      J := PageStart + DataPerPage - I - 1;
      P := PStkDataRec(StkDataFile.getData(J));
      if P <> nil then
      begin
        Y1 := Fy2Iy(P^.OP / 100.0, R, High, Low);
        Y2 := Fy2Iy(P^.CP / 100.0, R, High, Low);
        M := Min(Y1, Y2); //Measured by pixels
        N := Max(Y1, Y2); //Measured by pixels
        //
        X1 := UnitWidth * I + UnitWidth div 2;
        X2 := X1;
        Y1 := Fy2Iy(P^.HP / 100.0, R, High, Low);
        Y2 := Fy2Iy(P^.LP / 100.0, R, High, Low);
        if UnitWidth > 2 then
        begin //K-Char上下影线
          _line_(C, X1, Y1, X2, M, clWhite); //HP
          _line_(C, X1, N, X2, Y2, clWhite); //LP
        end
        else
          if UnitWidth < 2 then
            _line_(C, X1, Y1, X2, Y2) //HP to LP
          else
          begin
            //保留值
            X3 := X2;
            Y3 := Y2;
            C3 := C.Pen.Color;

            X2 := UnitWidth * (I + 1) + UnitWidth div 2;
            Y2 := Fy2Iy(P^.CP / 100.0, R, High, Low);
            _line_(C, X1, Y2, X2, Y2, clWhite); //CP to CP
            _line_(C, X1, Y1, X3, Y3, C3) //HP to LP
          end;
        //
        X1 := 1 + UnitWidth * I;
        X2 := UnitWidth * (I + 1);
        Y1 := Fy2Iy(P^.OP / 100.0, R, High, Low);
        Y2 := Fy2Iy(P^.CP / 100.0, R, High, Low);
        if Y1 > Y2 then
          C.Pen.Color := clRed
        else
          if Y1 < Y2 then
            C.Pen.Color := clAqua
          else
            C.Pen.Color := clLime;
        C.Brush.Color := C.Pen.Color;
        if UnitWidth > 2 then
        begin
          if (X1 = X2) or (Y1 = Y2) then
            _line_(C, X1, Y1, X2, Y2, clLime)
          else
            if Y1 > Y2 then
            begin
              C.Brush.Color := clBlack;
              C.Rectangle(Rect(X1, Y1, X2, Y2));
            end
            else
            begin
              C.Brush.Color := C.Pen.Color;
              C.Rectangle(Rect(X1, Y1, X2, Y2));
            end;
        end;
      end;
    end;

    if IS_DRAW_MA then
      for I := 0 to Length(MAC) - 1 do
        if MAC[I] > 0 then
          DrawLine(MA[I], DEF_COLOR[I], C, R, High, Low);

  end;
end;

procedure TfrmMain2.DrawScaleK(C: TCanvas; R: TRect);
var
  High, Low, D: Single;
  HIndex, LIndex: TArrayOfInteger;
  HA, LA  : TArrayOfSingle;
begin
  if FindKLineScaleHighLow(StkDataFile, High, Low, HA, LA, HIndex, LIndex) then
  begin
    ScaleHigh[1] := High;
    ScaleLow[1] := Low;
    D := (High - Low) / 20;
    High := High + D;
    Low := Low - D;
    InflateRect(R, 0, -2);
    DRAW_SCALE(C, R, ScaleLow[1], ScaleHigh[1], Low, High, _height_(R) div 25, True);
  end;
end;

procedure TfrmMain2.DrawV(C: TCanvas; R: TRect);
var
  D, High, Low: Single;
  I, J, X1, X2, Y1, Y2: Integer;
  P       : PStkDataRec;
begin
  if FindVLineScaleHighLow(StkDataFile, High, Low) then
  begin
    ScaleHigh[2] := High;
    ScaleLow[2] := Low;
    D := (High - Low) / 10;
    High := High + D;
    InflateRect(R, 0, -2);
    if ShowBackgroundDotLine then DRAW_HORZ_SCALE(C, R, ScaleLow[2], ScaleHigh[2], Low, High, _height_(R) div 25, True);
    _setPen_(C, GRID.Color, 1, psSolid, pmCopy);
    _setBrush_(C, GRID.Color, bsSolid);
    for I := 0 to DataPerPage - 1 do
    begin
      J := PageStart + DataPerPage - I - 1;
      P := StkDataFile.getData(J);
      if P <> nil then
      begin
        if P^.CP > P^.OP then
          C.Pen.Color := clRed
        else
          if P^.CP < P^.OP then
            C.Pen.Color := clAqua
          else
            C.Pen.Color := clLime;
        C.Brush.Color := C.Pen.Color;
        X1 := 1 + UnitWidth * I;
        X2 := UnitWidth * (I + 1);
        Y1 := R.Bottom;
        Y2 := Fy2Iy(P^.VOL / 100.0, R, High, Low);
        if UnitWidth > 2 then
          C.Rectangle(Rect(X1, Y1, X2, Y2))
        else
          _line_(C, X1, Y1, X1, Y2);
      end;
    end;

    if IS_DRAW_MA then
      for I := 0 to Length(VMAC) - 1 do
        if VMAC[I] > 0 then
          DrawLine(VMA[I], DEF_COLOR[I], C, R, High, Low);
  end;
end;

procedure TfrmMain2.DrawRSI(C: TCanvas; R: TRect);
var
  High, Low: Single;
  I, Y    : Integer;
begin
  High := 100;
  Low := 0;
  ScaleHigh[3] := 100;
  ScaleLow[3] := 0;
  InflateRect(R, 0, -2);
  _setBrush_(C, GRID.Color, bsSolid);
  if ShowBackgroundDotLine then
  begin
    _setPen_(C, clRed, 1, psDot, pmCopy);
    Y := Fy2Iy(80, R, High, Low);
    _line_(C, R.Left + 1, Y, R.Right, Y, clRed);
    Y := Fy2Iy(50, R, High, Low);
    _line_(C, R.Left + 1, Y, R.Right, Y, clSilver);
    Y := Fy2Iy(20, R, High, Low);
    _line_(C, R.Left + 1, Y, R.Right, Y, clAqua);
  end;
  _setPen_(C, clRed, 1, psSolid, pmCopy);

  for I := 0 to Length(RSIC) - 1 do
    if RSIC[I] > 0 then
      DrawLine(RSI[I], DEF_COLOR[I], C, R, High, Low);

end;

function TfrmMain2.FindKLineScaleHighLow(DataFile: IDataFile;
  var High, Low: Single; var HA, LA: TArrayOfSingle; var HIndex, LIndex: TArrayOfInteger): Boolean;
  function IsHighLabel(Index: Integer): Boolean;
  var
    I, SS, EE: Integer;
    FH    : Single;
    Interval: Integer;
  begin
    Result := False;
    Interval := Max(10, DataPerPage div 20);
    if Length(HA) = 0 then Exit;
    if Interval < 1 then Exit;
    if Index > -1 then
    begin
      FH := 0;
      SS := Max(0, Index - Interval);
      EE := Min(Length(HA) - 1, Index + Interval);
      for I := SS to EE do
        FH := Max(FH, HA[I]);
      Result := (HA[Index] = FH);
    end;
  end;

  function IsLowLabel(Index: Integer): Boolean;
  var
    I, SS, EE: Integer;
    FL    : Single;
    Interval: Integer;
  begin
    Result := False;
    Interval := Max(10, DataPerPage div 20);
    if Length(LA) = 0 then Exit;
    if Interval < 1 then Exit;
    if Index > -1 then
    begin
      FL := MaxSingle;
      SS := Max(0, Index - Interval);
      EE := Min(Length(LA) - 1, Index + Interval);
      for I := SS to EE do
        FL := Min(FL, LA[I]);
      Result := (LA[Index] = FL);
    end;
  end;
var
  I, J    : Integer;
  P       : PStkDataRec;
begin
  High := -MaxSingle;
  Low := MaxSingle;
  HA := nil;
  LA := nil;
  HIndex := nil;
  LIndex := nil;
  for I := 0 to DataPerPage - 1 do
  begin
    J := PageStart + DataPerPage - I - 1;
    P := PStkDataRec(DataFile.getData(J));
    if P <> nil then
    begin
      if miShowKLineHighLow.Checked then
      begin
        SetLength(HA, Length(HA) + 1);
        SetLength(LA, Length(LA) + 1);
        HA[Length(HA) - 1] := P.HP / 100.0;
        LA[Length(LA) - 1] := P.LP / 100.0;
        if Length(HA) > 1 then HA[Length(HA) - 1] := HA[Length(HA) - 1] * 0.9995 + HA[Length(HA) - 2] * 0.0005;
        if Length(LA) > 1 then LA[Length(LA) - 1] := LA[Length(LA) - 1] * 0.9995 + LA[Length(LA) - 2] * 0.0005;
      end;
      High := Max(High, P.HP / 100.0);
      Low := Min(Low, P.LP / 100.0);
    end;
  end;

  if miShowKLineHighLow.Checked then
  begin
    for I := 0 to DataPerPage - 1 do
    begin
      J := PageStart + DataPerPage - I - 1;
      if J > -1 then
      begin
        if IsHighLabel(I) then
        begin
          SetLength(HIndex, Length(HIndex) + 1);
          HIndex[Length(HIndex) - 1] := I;
        end
        else
          if IsLowLabel(I) then
          begin
            SetLength(LIndex, Length(LIndex) + 1);
            LIndex[Length(LIndex) - 1] := I;
          end
      end;
    end;
  end;

  Result := High > Low;

end;

function TfrmMain2.FindVLineScaleHighLow(DataFile: IDataFile; var High, Low: Single): Boolean;
var
  I, J    : Integer;
  P       : PStkDataRec;
begin
  High := -MaxSingle;
  Low := MaxSingle;
  for I := 0 to DataPerPage - 1 do
  begin
    J := PageStart + DataPerPage - I - 1;
    if _valid_(J, 0, DataFile.getCount - 1) then
    begin
      P := PStkDataRec(DataFile.getData(J));
      High := Max(High, P.VOL / 100.0);
      Low := Min(Low, P.VOL / 100.0);
    end;
  end;
  Result := High > Low;
end;

function TfrmMain2.Fy2Iy(FY: Single; R: TRect; ScaleHigh, ScaleLow: Single): Integer;
var
  RatioY  : Single;
begin
  Result := 0;
  if (ScaleHigh > ScaleLow) and (_height_(R) > 0) then
  begin
    RatioY := (ScaleHigh - ScaleLow) / _height_(R);
    if RatioY > 0 then Result := R.Top + Round((ScaleHigh - FY) / RatioY);
  end;
end;

function TfrmMain2.PageIndex2DataIndex(Index: Integer): Integer;
begin
  Result := StkDataFile.getCount - Index - 1;
end;

procedure TfrmMain2.DrawLine(A: TArrayOfSingle; Color: TColor;
  C: TCanvas; R: TRect; High, Low: Single);
var
  I, J, X, Y, Len: Integer;
  FirstDataFound: Boolean;
begin
  if A <> nil then
  begin
    FirstDataFound := False;
    _setPen_(C, Color, 1, psSolid, pmCopy);

    C.Brush.Color := GRID.Color;
    C.Brush.Style := bsSolid;
    Len := Length(A);
    for I := 0 to DataPerPage - 1 do
    begin
      J := PageStart + DataPerPage - I - 1;
      J := PageIndex2DataIndex(J);
      if _valid_(J, 0, Len - 1) then
      begin
        X := UnitWidth * I + UnitWidth div 2;
        Y := Fy2Iy(A[J], R, High, Low);
        if not FirstDataFound then
        begin
          C.MoveTo(X, Y);
          FirstDataFound := True;
        end
        else
          C.LineTo(X, Y);
      end;
    end;
  end;
end;

procedure TfrmMain2.DRAW_DATE_SCALE(C: TCanvas; R: TRect; ShowText: Boolean);
  procedure deDate(date: Integer; var Y, M, D: Word);
  begin
    Y := date div 10000;
    M := (date - Y * 10000) div 100;
    D := (date - Y * 10000 - M * 100);
  end;
var
  Rt      : TRect;
  str     : string;
  I, J, TW, TH: Integer;
  Y, M, D, Y1, m1, d1, ymd: Word;
  P, Q    : PStkDataRec;
  XX, YY  : Integer;
begin
  try
    for I := 0 to DataPerPage do
    begin
      J := PageStart + DataPerPage - I - 1;
      P := StkDataFile.getData(J);
      Q := StkDataFile.getData(J + 1);
      if (P <> nil) and (Q <> nil) then
      begin
        deDate(P^.date, Y, M, D);
        deDate(Q^.date, Y1, m1, d1);
        ymd := _if_(M <> m1, M, 0);
        if ymd <> 0 then
        begin
          XX := UnitWidth * I + UnitWidth div 2; // In pixels
          _setBrush_(C, GRID.Color, bsSolid);
          if ShowBackgroundDotLine then
          begin
            _setPen_(C, cl3DDkShadow, 1, psDot, pmCopy);
            C.MoveTo(XX, R.Top);
            C.LineTo(XX, R.Bottom);
          end
          else
            _setPen_(C, GRID.Color, 1, psDot, pmCopy);

          if ShowText then
          begin
            str := IntToStr(ymd);
            C.Font.Name := '宋体';
            C.Font.Height := Max(2, Round(_height_(R) * 0.05) - 2);
            TW := C.TextWidth(str);
            TH := C.TextHeight(str);
            YY := R.Bottom - TH;
            Rt := _Offset_(Rect(0, 0, TW, TH), XX + 1, YY - 1);
            _textRect_(C, Rt, str, clWhite, GRID.Color, taLeftJustify, tlBottom, True); //这里是画下面的日期标志的文字
          end;
        end;
      end;
    end;
    C.Pen.Style := psSolid;

  except
    Showmessage('没有该代号的日K线数据, 请关闭K线窗口!');
  end;
end;

procedure TfrmMain2.mi100Click(Sender: TObject);
begin
  with TMenuItem(Sender) do
  begin
    Checked := not Checked;
    case Tag of
      100: IS_DRAW_MA := Checked;
      101: IS_SHOW_DATESCALE := Checked;
      102: ShowBackgroundDotLine := Checked;
      103: IS_FRACTION_UNDERLINE := Checked;
    end;
    GRID.Repaint;
    ITERATE_DATA(DataIndex);
  end;
end;

procedure TfrmMain2.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if ((Key > '0') or (Key < 'Z')) and not (Key = #27) then
  begin
    if (Panel1.Visible = False) then
    begin
      Panel1.Visible := True;
      Edit1.Text := Char(Key);
      Edit1.SetFocus;