关于股票的问题一再出现,小弟现给出一思路,向各位大虾献丑了,
程序主要解决读乾隆数据,和画k线图的问题,没用任何第三方控件。
原文已发往《计算机世界》片稿费了
注意:程序只事例读一个*.day文件。其他可以举一反三。
{**********************************************************************}
{*程序描述: 如何用Delphi读钱龙数据画股票k线图范例 *}
{* 程序 : 战晓冬 *}
{* 编译器 : Borland Delphi Enterprise 5.0 (Build5.62)*}
{* Copyright(C) : 战晓冬 2000 *}
{**********************************************************************}
unit StockUn;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ToolWin, Menus, ExtCtrls, TeeProcs, TeEngine, Chart, mxgraph,
Series, StdCtrls, ArrowCha, Buttons;
type
TStockRec = packed record {定义一个记录,保存股票信息。}
Date: Longint; {时间}
Open:longint; {开盘}
High:longint; {最高价}
Low:longint; {最低价}
Close:longint; {收盘}
Amount:longint; {成交额}
Volume:longint; {成交量}
Topiece:longint;
X1:longint;
X2:longint;
end;
TRecordStream = class(TFileStream)
private
function GetNumRecs: Longint;
function GetCurRec: Longint;
procedure SetCurRec(RecNo: Longint);
protected
function GetRecSize: Longint; virtual;
public
function SeekRec(RecNo: Longint; Origin: Word): Longint;
function WriteRec(const Rec): Longint;
function AppendRec(const Rec): Longint;
function ReadRec(var Rec): Longint;
procedure First;
procedure Last;
procedure NextRec;
procedure PreviousRec;
property NumRecs: Longint read GetNumRecs;
property CurRec: Longint read GetCurRec write SetCurRec;
end;
TStockForm = class(TForm)
StatusBar1: TStatusBar;
Chart1: TChart;
Series1: TLineSeries;
Series2: TFastLineSeries;
Series3: TFastLineSeries;
Series4: TFastLineSeries;
SpeedButton1: TSpeedButton;
Label1: TLabel;
Label2: TLabel;
procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Series1AfterDrawValues(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure Chart1AfterDraw(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
OldX,OldY:Longint;
CrossHairColor:TColor;
CrossHairStyle:TPenStyle;
stockRec: TstockRec;
RecordStream: TRecordStream;
DayFile:File of TStockRec;
Fname:String;
procedure ChartADDData;
procedure DrawCross(AX,AY:Integer);
end;
var
StockForm: TStockForm;
implementation
function TRecordStream.GetRecSize:Longint; {返回记录长度}
begin
Result := SizeOf(TStockRec);
end;
function TRecordStream.GetNumRecs: Longint; {返回记录个数}
begin
Result := Size div GetRecSize;
end;
{返回当前记录位置,文件指针通常在记录的开始,而非Position div GetRecSize处。}
function TRecordStream.GetCurRec: Longint;
begin
Result := (Position div GetRecSize) + 1;
end;
procedure TRecordStream.SetCurRec(RecNo: Longint); {通过RecNo将记录定位}
begin
if RecNo > 0 then
Position := (RecNo - 1) * GetRecSize
else
Raise Exception.Create('Cannot go beyond beginning of file.');
end;
{通过RecNo将文件指针定位}
function TRecordStream.SeekRec(RecNo: Longint; Origin: Word): Longint;
begin
Result := Seek(RecNo * GetRecSize, Origin);
end;
function TRecordStream.WriteRec(Const Rec): Longint; {将记录Rec写入流中}
begin
Result := Write(Rec, GetRecSize);
end;
function TRecordStream.AppendRec(Const Rec): Longint; {将记录Rec写入流中}
begin
Seek(0, 2);
Result := Write(Rec, GetRecSize);
end;
function TRecordStream.ReadRec(var Rec): Longint; {从流中读取记录并将指针返回记录开始}
begin
Result := Read(Rec, GetRecSize);
Seek(-GetRecSize, 1);
end;
procedure TRecordStream.First; {将指针返回流的开始}
begin
Seek(0, 0);
end;
procedure TRecordStream.Last; {将指针返回流的末尾}
begin
Seek(0, 2);
Seek(-GetRecSize, 1);
end;
procedure TRecordStream.NextRec; {只要未到文件末尾,就将文件指针定在下一记录处}
begin
if ((Position + GetRecSize) div GetRecSize) = GetNumRecs then
raise Exception.Create('Cannot read beyond end of file')
else
Seek(GetRecSize, 1);
end;
procedure TRecordStream.PreviousRec;{只要未到文件开始,就将文件指针定在前一记录处}
begin
if (Position - GetRecSize >= 0) then
Seek(-GetRecSize, 1)
else
Raise Exception.Create('Cannot read beyond beginning of the file.');
end;
{$R *.DFM}
procedure TStockForm.Chart1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
tmpX,tmpY
ouble;
begin
if (OldX<>-1) then
begin
DrawCross(OldX,OldY); {画小十字鼠标}
OldX:=-1;
end;
{检查鼠标是否在图表区}
if PtInRect( Chart1.ChartRect, Point(X-Chart1.Width3D,Y+Chart1.Height3D)) then
begin
DrawCross(x,y); {在当前位置画十字准线}
OldX:=x; {保存旧位置}
OldY:=y;
With Series1 do {设置标签文本}
begin
GetCursorValues(tmpX,tmpY); {获取鼠标位置数据}
Label1.Caption:=GetVertAxis.LabelValue(tmpY)+' '+
GetHorizAxis.LabelValue(tmpX);
end;
end;
end;
procedure TStockForm.FormCreate(Sender: TObject);
begin
OldX:=-1; {初始化变量}
CrossHairColor:=clRed; {颜色}
CrossHairStyle:=psSolid; {线形}
Fname:='600734.Day';
if FileExists(FName) then
RecordStream := TRecordStream.Create(FName, fmOpenReadWrite)
else
RecordStream := TRecordStream.Create(FName, fmCreate);
end;
procedure TStockForm.FormDestroy(Sender: TObject);
begin
RecordStream.Free;
end;
procedure TStockForm.FormActivate(Sender: TObject);
begin
RecordStream.Last;
ChartADDData;
while (((RecordStream.Position + 40) div 40) > RecordStream.NumRecs-9) do
begin
RecordStream.PreviousRec;
ChartADDData;
end;
end;
procedure TStockForm.ChartADDData;
var
FormatDayLineDateYear,FormatDayLineDateMonth,
FormatDayLineDateDay,FormatDayLineDate,DayLineDate:string;
begin
RecordStream.ReadRec(stockRec);
DayLineDate:=IntToStr(StockRec.Date);{将日期数转化成字符串}
FormatDayLineDateYear:=Copy(DayLineDate,2,2);{分离出年}
FormatDayLineDateMonth:=Copy(DayLineDate,5,2);{分离处月}
FormatDayLineDateDay:=Copy(DayLineDate,7,2); {分离出日}
FormatDayLineDate:=Concat(FormatDayLineDateYear,'-',FormatDayLineDateMonth,'-',FormatDayLineDateDay);
Series1.Add((stockRec.open / 1000),FormatDayLineDate,clBlack);
Series2.Add((stockRec.close / 1000),FormatDayLineDate,clTeeColor);
Series3.Add((stockRec.Low / 1000),FormatDayLineDate,clTeeColor);
Series4.Add((stockRec.High / 1000),FormatDayLineDate,clTeeColor);
end;
procedure TStockForm.DrawCross(AX,AY:Integer); {画十字线鼠标}
begin
With Chart1,Canvas do
begin
Pen.Color:=CrossHairColor; {画笔颜色}
Pen.Style:=CrossHairStyle; {画笔类型}
Pen.Mode:=pmXor; {如何画线}
Pen.Width:=1; {画笔宽度}
MoveTo(ax,ChartRect.Top-Height3D);
LineTo(ax,ChartRect.Bottom-Height3D);
MoveTo(ChartRect.Left+Width3D,ay);
LineTo(ChartRect.Right+Width3D,ay);
end;
end;
procedure TStockForm.Series1AfterDrawValues(Sender: TObject);
begin
OldX:=-1; {重置鼠标原来位置}
end;
procedure TStockForm.SpeedButton1Click(Sender: TObject);
begin
Series1.Clear;
RecordStream.First;
ChartADDData;
while ((RecordStream.Position + 40) div 40) < RecordStream.NumRecs do
begin
RecordStream.NextRec;
ChartADDData;
end;
RecordStream.last;
ChartADDData;
end;
procedure TStockForm.Chart1AfterDraw(Sender: TObject); {画阴阳线}
var
XValueNO:integer; {X轴点}
begin
With Chart1,Canvas do
begin
for XValueNO:=0 to Series1.LastValueIndex do
begin
begin
if (Series1.CalcyPos(XValueNO) < Series2.CalcyPos(XValueNO)) then
begin
Brush.Color:=clWhite;
Pen.Color:=clWhite; {画笔颜色}
end
else
begin
Brush.Color:=clRed;
Pen.Color:=clRed;
end;
end;
Pen.Style:=pssolid; {画笔类型}
Pen.Width:=1;
begin
MoveTo(Series3.CalcXPos(XValueNO) ,Series3.CalcyPos(XValueNO));
LineTo(Series4.CalcXPos(XValueNO) ,Series4.CalcyPos(XValueNO));
Rectangle(Series1.CalcXPos(XValueNO)-5,Series1.CalcyPos(xValueNO),
Series1.CalcXPos(XValueNO)+5,Series2.CalcyPos(xValueNO));
end;
end;
end;
end;
end.