fmain2.pas

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

      Edit1.SetSelection(2, 1);
    end;
  end;
  case Key of
    '+', '=': UnitWidth := UnitWidth + 2;
    '-': UnitWidth := UnitWidth - 2;
  end;
end;

procedure TfrmMain2.mi0Click(Sender: TObject);
begin
  StockName := Trim(TMenuItem(Sender).Caption);
end;

procedure TfrmMain2.N5Click(Sender: TObject);
begin
  UnitWidth := UnitWidth + 2;
end;

procedure TfrmMain2.N6Click(Sender: TObject);
begin
  UnitWidth := UnitWidth - 2;
end;

procedure TfrmMain2.DrawScaleV(C: TCanvas; R: TRect);
var
  D, High, Low: Single;
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);
    DRAW_SCALE(C, R, ScaleLow[2], ScaleHigh[2], Low, High, _height_(R) div 25, True, True);
  end;
end;

procedure TfrmMain2.SetDataIndex(Value: Integer);
var
  LB, RB, Diff: Integer;
begin
  if StkDataFile <> nil then
  begin
    Value := Max(-Max(1, DataPerPage div 8), Min(StkDataFile.getCount - 1, Value));
    if Value <> FDataIndex then
    begin
      LB := PageStart + DataPerPage - 1;
      RB := PageStart;
      Diff := Value - FDataIndex;
      if (Value < RB) or (Value > LB) then
        PageStart := PageStart + Diff; //DataPerPage div 4
      FDataIndex := Value;
      MOVE_VERTLINE(FDataIndex);
      ITERATE_DATA(FDataIndex);
    end;
  end;
end;

procedure TfrmMain2.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (Key = VK_Escape) then
  begin
    Self.Close;
  end;
  if (Key = VK_Down) then
  begin
    UnitWidth := UnitWidth - 2;
  end
  else
    if (Key = VK_UP) then
    begin
      UnitWidth := UnitWidth + 2;
    end;

  if Shift = [] then
  begin
    case Key of
      VK_LEFT: miLeftOne.Click;
      VK_RIGHT: miRightOne.Click;
      VK_HOME: miPageFirst.Click;
      VK_END: miPageLast.Click;
    end;
  end
  else
    if Shift = [ssCtrl] then
    begin
      case Key of
        VK_LEFT: miQuickLeft.Click;
        VK_RIGHT: miQuickRight.Click;
        VK_HOME: miFirst.Click;
        VK_END: miLast.Click;
      end;
    end;
end;

procedure TfrmMain2.ITERATE_DATA(Index: Integer);
  function deDate(date: Integer): string;
  var
    s     : string;
  begin
    s := IntToStr(date);
    s := copy(s, 1, 4) + '-' + copy(s, 5, 2) + '-' + copy(s, 7, 2);
    Result := s;
  end;
var
  I       : Integer;
  P, Q    : PStkDataRec;
begin
  if StkDataFile <> nil then
  begin
    P := StkDataFile.getData(Index);
    Q := StkDataFile.getData(Index + 1);
    if P <> nil then
    begin
      Header.Cells[01, 0] := deDate(P.date);
      Header.Cells[03, 0] := _vs_(P.OP / 100.0);
      Header.Cells[05, 0] := _vs_(P.HP / 100.0);
      Header.Cells[07, 0] := _vs_(P.LP / 100.0);
      Header.Cells[09, 0] := _vs_(P.CP / 100.0);

      if Q = nil then
        Header.Cells[11, 0] := ''
      else
        Header.Cells[11, 0] := _vs_((P.CP - Q.CP) / 100.0, 2, True, True);

      Header.Cells[13, 0] := _vs_(P.VOL / 100.0, _if_(Pos('指数', StockName) > 0, 2, 0));
    end
    else
    begin
      {
      //Header.Cells[01, 0] := IntToStr(FDataIndex);
      //Header.Cells[01, 0] := SName;
      for I := 2 to Header.ColCount - 1 do
      begin
        if I mod 2 = 1 then
          Header.Cells[I, 0] := '';
      end;
      }
    end;
  end;
end;

procedure TfrmMain2.MDAC1Click(Sender: TObject);
begin
  Self.CalaMDAC;
end;

procedure TfrmMain2.N3Click(Sender: TObject);
var
  I       : Integer;
  mi      : TMenuItem;
begin
  mi := TMenuItem(Sender);
  for I := 0 to mi.Count - 1 do
  begin
    mi.Items[I].Checked := Pos(StockName, mi.Items[I].Caption) > 0;
  end;
end;

procedure TfrmMain2.HeaderDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var
  Q       : TTextRectInfo;
begin
  Q := _rec_(Rect, Header.Cells[ACol, ARow], clWhite, clBlack, taCenter, tlCenter);
  GRID.Canvas.Font.Name := _if_(ACol mod 2 = 0, '楷体', '宋体');
  case ACol of
    00: Q.FC := clYellow;
    01: Q.FC := clWhite;
    11: Q.FC := _if_(Pos('+', Q.s) > 0, clRed, _if_(Pos('-', Q.s) > 0, clAqua, Q.FC));
  else
    Q.FC := _if_(ACol mod 2 = 0, clSilver, clFuchsia);
  end;

  case ACol of
    11, 13: Q.AL := taLeftJustify;
    1:
      begin
        if FDataIndex > -1 then
          Q.AL := taRightJustify
        else
          Q.AL := taCenter;
      end;
  end;

  with Q do
    _textRect_(Header.Canvas, R, s, FC, BC, AL, TL, Transparent);
end;

procedure TfrmMain2.miPageLastClick(Sender: TObject);
begin
  DataIndex := Max(0, PageStart);
end;

procedure TfrmMain2.miLeftOneClick(Sender: TObject);
begin
  DataIndex := DataIndex + 1;
end;

procedure TfrmMain2.miRightOneClick(Sender: TObject);
begin
  DataIndex := DataIndex - 1;
end;

{ TVertLine }

constructor TVertLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVisible := True;
  FPosition := 100;
  Parent := TfrmMain2(Owner).GRID;
  Align := alClient;
  Width := 1;
end;

procedure TVertLine.Paint;
begin
  if Visible then
  begin
    _setPen_(Canvas, clFuchsia, 1, psSolid, pmXOR);
    _line_(Canvas, FPosition, 26, FPosition, Parent.ClientHeight - 1);
  end;
end;

procedure TVertLine.SetPosition(const Value: Integer);
begin
  if Value <> FPosition then
  begin
    Paint;
    FPosition := Value;
    Paint;
  end;
end;

procedure TfrmMain2.FormDestroy(Sender: TObject);
begin
  _free_(VertLine);
  _free_(HorztLine);
end;

procedure TfrmMain2.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Shift = [ssLeft] then DataIndex := PixelToDataIndex(X);
  if (DataIndex < 0) then
  begin
    GRID.Invalidate;
  end;
end;

procedure TfrmMain2.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  HorztLine.Position := Y;
  VertLine.Position := X;
  DataIndex := PixelToDataIndex(X);
end;

procedure TfrmMain2.FormActivate(Sender: TObject);
begin
  if (VertLine <> nil) and VertLine.Visible then VertLine.Paint;
end;

function TfrmMain2.DataIndexToPixel(DataIndex: Integer): Integer;
begin
  Result := PageStart + DataPerPage - DataIndex - 1;
  Result := Result * UnitWidth + UnitWidth div 2;
end;

procedure TfrmMain2.MOVE_VERTLINE(DataIndex: Integer);
begin
  VertLine.Position := DataIndexToPixel(FDataIndex);
end;

procedure TfrmMain2.miPageFirstClick(Sender: TObject);
begin
  DataIndex := PageStart + DataPerPage - 1;
end;

procedure TfrmMain2.miFirstClick(Sender: TObject);
begin
  if StkDataFile <> nil then
  begin
    PageStart := StkDataFile.getCount - DataPerPage;
    DataIndex := StkDataFile.getCount - 1;
  end;
end;

procedure TfrmMain2.miLastClick(Sender: TObject);
begin
  PageStart := 0;
  DataIndex := 0;
end;

procedure TfrmMain2.miQuickLeftClick(Sender: TObject);
begin
  DataIndex := DataIndex + DataPerPage div 8;
end;

procedure TfrmMain2.miQuickRightClick(Sender: TObject);
begin
  DataIndex := DataIndex - DataPerPage div 8;
end;

procedure TfrmMain2.CLEAR_ALL_CALCULATE_DATA;
var
  I       : Integer;
begin
  for I := 0 to Length(MA) - 1 do
    MA[I] := nil;
  for I := 0 to Length(VMA) - 1 do
    VMA[I] := nil;
  for I := 0 to Length(RSI) - 1 do
    RSI[I] := nil;
end;

function TfrmMain2.PixelToDataIndex(X: Integer): Integer;
begin
  Result := PageStart + DataPerPage - Round((X - UnitWidth div 2) / UnitWidth) - 1;
end;

procedure TfrmMain2.N11Click(Sender: TObject);
begin
  GRID.Invalidate;
end;

{ THorztLine }

constructor THorztLine.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVisible := True;
  Parent := TfrmMain2(Owner).GRID;
  Align := alClient;
  Width := 1;
end;

procedure THorztLine.Paint;
begin
  if Visible then
  begin
    _setPen_(Canvas, clWhite, 1, psSolid, pmXOR);
    _line_(Canvas, 1, FPosition, Parent.ClientWidth - 3, FPosition);
  end;

end;

procedure THorztLine.SetPosition(const Value: Integer);
begin
  if Value <> FPosition then
  begin
    Paint;
    FPosition := Value;
    Paint;
  end;
end;

procedure TfrmMain2.DrawMDAC(C: TCanvas; R: TRect);
var
  High, Low: Single;
  I, J, Y : Integer;
  X1, Y1, X2, Y2: Integer;
  Max     : Integer;
begin
  High := 10;
  Low := -10;
  ScaleHigh[3] := 10;
  ScaleLow[3] := -10;
  InflateRect(R, 0, -2);
  _setBrush_(C, GRID.Color, bsSolid);
  if ShowBackgroundDotLine then
  begin
    _setPen_(C, clRed, 1, psDot, pmCopy);
    Y := Fy2Iy(10, R, High, Low);
    _line_(C, R.Left + 1, Y, R.Right, Y, clRed);
    Y := Fy2Iy(0.0, R, High, Low); //画中线
    _line_(C, R.Left + 1, Y, R.Right, Y, clWhite);
    Y := Fy2Iy(-10, R, High, Low);
    _line_(C, R.Left + 1, Y, R.Right, Y, clRed);
  end;
  _setPen_(C, clRed, 1, psSolid, pmCopy);
  Y := Fy2Iy(0.0, R, High, Low); //画中线
  for I := 0 to 3 do
  begin
    Max := Length(MDAC[I]);
    for J := 0 to Max - 1 do
    begin
      if (I = 0) then
      begin
        //功EMA12的曲线
      end;
      if (I = 1) then
      begin
        //画EMA26的曲线
      end;
      if (I = 2) then
      begin
        //画上线波浪线
        X1 := UnitWidth * I + UnitWidth div 2;
        Y1 := Fy2Iy(MDAC[I][J], R, High, Low);
        if (MDAC[I][J] > 0) then
        begin
          _line_(C, X1 * J, Y, X1 * J, Y1, clRed);
        end
        else
        begin
          _line_(C, X1 * J, Y, X1 * J, Y1, clGreen);
        end;
      end;

    end;
  end;
end;

procedure TfrmMain2.MDAC2Click(Sender: TObject);
var
  C       : TCanvas;
begin

end;

procedure TfrmMain2.Edit1PropertiesChange(Sender: TObject);
var
  SQL_Str : string;
  Len     : Word;
begin
  if (Edit1.Text <> '') then
  begin
    Len := Length(Edit1.Text);
    SQL_Str := ' Select TOP 25  股票代号,股票名称 From BaseInfo'
      + ' Where (股票代号  Like ' + #39 + '%' + Edit1.Text + '%' + #39 + ')'
      + ' OR (股票名称 Like ' + #39 + '%' + Edit1.Text + '%' + #39 + ')'
      + ' OR (助记码 Like ' + #39 + '%' + Edit1.Text + '%' + #39 + ')'
      + ' Order By 股票代号';
    {
        SQL_Str := ' Select TOP 25  股票代号,股票名称 From BaseInfo'
          + ' Where (Left(股票代号,' + IntToStr(Len) + ')=' + #39 + Edit1.Text + #39 + ')'
          + ' OR (Left(股票名称,' + IntToStr(Len) + ')=' + #39 + Edit1.Text + #39 + ')'
          + ' OR (Left(助记码,' + IntToStr(Len) + ')=' + #39 + Edit1.Text + #39 + ')'
          + ' Order By 股票代号';
          }
    InfoQuery.Active := False;
    InfoQuery.SQL.Clear;
    InfoQuery.SQL.Add(SQL_Str);
    InfoQuery.Open;
  end;
end;

procedure TfrmMain2.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Return) then
  begin
    if (Edit1.Text <> '') then
    begin
      if (InfoQuery.RecordCount > 0) then
      begin
        Panel1.Visible := False;
        Self.StockName := InfoQuery.FieldByName('股票代号').AsString;
      end;
    end;
  end;
end;

procedure TfrmMain2.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #27) then
  begin
    Panel1.Visible := False;
  end;
end;

end.