main.pas

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

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, cxGraphics, DB, MemDS, VirtualTable, cxControls, cxContainer,
  cxEdit, cxTextEdit, cxMaskEdit, cxDropDownEdit, cxMRUEdit, fmMRUEdit,
  ADODB, Grids, DBGridEh, StdCtrls, ImgList, ExtCtrls, RzStatus, RzPanel,
  RzButton, ToolWin, ComCtrls, Buttons, ComObj, ActiveX;

type
  TMainForm = class(TForm)
    CoolBar2: TCoolBar;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzToolButton2: TRzToolButton;
    RzToolButton3: TRzToolButton;
    RzToolButton4: TRzToolButton;
    RzToolButton5: TRzToolButton;
    RzToolButton6: TRzToolButton;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    StatusBar1: TRzStatusBar;
    RzStatusPane1: TRzStatusPane;
    RzStatusPane2: TRzStatusPane;
    RzStatusPane3: TRzStatusPane;
    RzStatusPane4: TRzStatusPane;
    RzClockStatus1: TRzClockStatus;
    RzStatusPane5: TRzStatusPane;
    Panel1: TPanel;
    ImageList1: TImageList;
    GroupBox1: TGroupBox;
    DBGridEh2: TDBGridEh;
    InfoQuery: TADOQuery;
    MC: TADOConnection;
    DBGridEh1: TDBGridEh;
    DataSource1: TDataSource;
    GPDataQuery: TADOQuery;
    GPDataQueryDSDesigner: TWideStringField;
    GPDataQueryDSDesigner2: TWideStringField;
    GPDataQueryDSDesigner3: TWideStringField;
    GPDataQueryDSDesigner4: TWideStringField;
    GPDataQueryDSDesigner5: TFloatField;
    GPDataQueryDSDesigner6: TIntegerField;
    GPDataQueryDSDesigner7: TFloatField;
    GPDataQueryDSDesigner8: TIntegerField;
    GPDataQueryDSDesigner9: TDateTimeField;
    GPDataQueryDSDesigner10: TFloatField;
    GPDataQueryDSDesigner11: TFloatField;
    GPDataQueryDSDesigner12: TFloatField;
    GPDataQueryDSDesigner13: TFloatField;
    GPDataQueryDSDesigner14: TFloatField;
    GPDataQueryDSDesigner15: TFloatField;
    GPDataQueryDSDesigner16: TIntegerField;
    GPDataQueryDSDesigner17: TFloatField;
    GPDataQueryDSDesigner18: TFloatField;
    GPDataQueryField: TFloatField;
    GPDataQueryField2: TFloatField;
    DataSource2: TDataSource;
    Edit1: TcxTextEdit;
    procedure FormShow(Sender: TObject);
    procedure RzToolButton6Click(Sender: TObject);
    procedure RzToolButton4Click(Sender: TObject);
    procedure DBGridEh1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure RzToolButton1Click(Sender: TObject);
    procedure DBGridEh1DblClick(Sender: TObject);
    procedure DBGridEh1GetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure DBGridEh1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Edit1PropertiesChange(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton1Click(Sender: TObject);
    procedure DBGridEh2DblClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RzToolButton5Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
    procedure DBGridEh2KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

uses ProcessData, fMain2;

{$R *.dfm}
function CompactDatabase(AFileName, APassWord: string): boolean;
//压缩与修复数据库,覆盖源文件
const
  SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
    + 'Jet OLEDB:Database Password=%s;';
var
  SPath, SFile: array[0..254] of Char;
  STempFileName: string;
  JE      : OleVariant;
begin
  GetTempPath(40, SPath); //取得Windows的Temp路径
  GetTempFileName(SPath, '~CP', 0, SFile); //取得Temp文件名,Windows将自动建立0字节文件
  STempFileName := SFile; //PChar->String
  DeleteFile(STempFileName); //删除Windows建立的0字节文件
  try
    JE := CreateOleObject('JRO.JetEngine'); //建立OLE对象,函数结束OLE对象超过作用域自动释放
    OleCheck(JE.CompactDatabase(format(SConnectionString, [AFileName, APassWord]),
      format(SConnectionString, [STempFileName, APassWord]))); //压缩数据库
    //复制并覆盖源数据库文件,如果复制失败则函数返回假,压缩成功但没有到函数的功能
    result := CopyFile(PChar(STempFileName), PChar(AFileName), false);
    DeleteFile(STempFileName); //删除临时文件
  except
    result := false; //压缩失败
  end;
end;

procedure TMainForm.FormShow(Sender: TObject);
begin
  GPDataQuery.Filtered := false;
  GPDataQuery.Filter := '标志=' + #39 + '0' + #39;
  GPDataQuery.Filtered := True;
  Panel1.Top := screen.Height - Panel1.Height - 70;
  Panel1.Left := screen.Width - Panel1.Width - 10;
end;

procedure TMainForm.RzToolButton6Click(Sender: TObject);
begin
  Close;
end;

procedure TMainForm.RzToolButton4Click(Sender: TObject);
begin
  ProcessDataForm := TProcessDataForm.Create(Self);
  ProcessDataForm.ShowModal;
end;

procedure TMainForm.DBGridEh1DrawColumnCell(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumnEh;
  State: TGridDrawState);
begin
  with DBGridEh1.DataSource.DataSet do
  begin
    if DataCol = 0 then //第一列
      DBGridEh1.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, IntToStr(RecNo));
  end;
  with (Sender as TDBGridEh).Canvas do //画 cell 的边框
  begin
    Pen.Color := $00DFFFFF; //定义画笔颜色(蓝色)
    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 TMainForm.RzToolButton1Click(Sender: TObject);
begin
  frmMain2 := TfrmMain2.Create(Self);
  frmMain2.SName := GPDataQuery.FieldByName('股票名称').AsString;
  frmMain2.SID := GPDataQuery.FieldByName('股票代号').AsString;
  frmMain2.ShowModal;
end;

procedure TMainForm.DBGridEh1DblClick(Sender: TObject);
begin
  Self.RzToolButton1.Click;
end;

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

procedure TMainForm.DBGridEh1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Return) then
  begin
    Panel1.Visible := false;
    Self.RzToolButton1.Click;
  end;
  if (Key = VK_Escape) then
  begin
    Panel1.Visible := false;
  end;
end;

procedure TMainForm.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 TMainForm.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_down) then
  begin
    DBGridEh2.SetFocus;
    InfoQuery.Next;
  end;
  if (Key = VK_Return) then
  begin
    if (Edit1.Text <> '') then
    begin
      if (Edit1.Text = '61') then
      begin
        GPDataQuery.Filtered := false;
        GPDataQuery.Filter := '标志=' + #39 + '1' + #39;
        GPDataQuery.Filtered := True;
        Abort;
      end;
      if (Edit1.Text = '63') then
      begin
        GPDataQuery.Filtered := false;
        GPDataQuery.Filter := '标志=' + #39 + '0' + #39;
        GPDataQuery.Filtered := True;
        Abort;
      end;
      if (InfoQuery.RecordCount > 0) then
      begin
        Panel1.Visible := false;
        frmMain2 := TfrmMain2.Create(Self);
        frmMain2.SName := InfoQuery.FieldByName('股票名称').AsString;
        frmMain2.SID := InfoQuery.FieldByName('股票代号').AsString;
        frmMain2.ShowModal;
      end;
    end;
  end;
end;

procedure TMainForm.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;
      Edit1.SetSelection(2, 1);
    end;
  end;

end;

procedure TMainForm.SpeedButton1Click(Sender: TObject);
begin
  Panel1.Visible := false;
end;

procedure TMainForm.DBGridEh2DblClick(Sender: TObject);
begin
  if (InfoQuery.RecordCount > 0) then
  begin
    Panel1.Visible := false;
    frmMain2 := TfrmMain2.Create(Self);
    frmMain2.SName := InfoQuery.FieldByName('股票名称').AsString;
    frmMain2.SID := InfoQuery.FieldByName('股票代号').AsString;
    frmMain2.ShowModal;
  end;
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
  MC.Connected := True;
  GPDataQuery.Active := True;
end;

procedure TMainForm.RzToolButton5Click(Sender: TObject);
begin
  GPDataQuery.Close;
  MC.Connected := false;
  if (CompactDatabase('StockInfo.mdb', '')) then
  begin
    showmessage('基础数据库收缩成功!');
  end;
  MC.Connected := True;
  GPDataQuery.Active := True;
end;

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

procedure TMainForm.DBGridEh2KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key = VK_Return) then
  begin
    if (InfoQuery.RecordCount > 0) then
    begin
      Panel1.Visible := false;
      frmMain2 := TfrmMain2.Create(Self);
      frmMain2.SName := InfoQuery.FieldByName('股票名称').AsString;
      frmMain2.SID := InfoQuery.FieldByName('股票代号').AsString;
      frmMain2.ShowModal;
    end;
  end;
end;

end.