// if Assigned(APointArray) then
// FPointOfArray:=@APointArray;
end;
destructor TCurve.Destroy;
begin
FPen.Free;
FBrush.Free;
FFont.Free;
inherited;
end;
procedure TCurve.Paint(ACanvas: TCanvas);
var
i:Integer;
begin
with Acanvas do
begin
Pen:=FPen;
Brush:=FBrush;
Font:=FFont;
end;
ACanvas.MoveTo(FPointArray[0].x,FPointArray[0].y);
for I:=Low(FPointArray)+1 to High(FPointArray) do
ACanvas.LineTo(FPointArray.x,FPointArray.y);
end;
procedure TCurve.SetBrush(const Value: TBrush);
begin
FBrush := Value;
end;
procedure TCurve.SetCaption(const Value: String);
begin
FCaption := Value;
end;
procedure TCurve.SetFont(const Value: TFont);
begin
FFont := Value;
end;
procedure TCurve.SetPen(const Value: TPen);
begin
FPen := Value;
end;
procedure TCurve.SetPointArray(const Value: TPointArray);
begin
FPointArray := Value;
end;
{ TLogGraph }
constructor TLogGraph.Create(Owner: TComponent);
begin
inherited;
FCurves:=TCurves.Create(self);
FBorderStyle:=bsNone;
FPen:=TPen.Create;
FBrush:=TBrush.Create;
end;
destructor TLogGraph.Destroy;
begin
FPen.Free;
FBrush.Free;
inherited;
end;
procedure TLogGraph.Paint;
var
i:Integer;
begin
inherited;
with Canvas do
begin
Pen:=FPen;
Brush:=FBrush;
end;
case FBorderStyle of
bsSingle:Canvas.Rectangle(0,0,width,Height);
end;
for I:=0 to FCurves.Count-1 do
FCurves.Item.Paint(Canvas);
end;
procedure TLogGraph.SetBorderStyle(const Value: TBorderStyle);
begin
FBorderStyle := Value;
end;
procedure TLogGraph.SetBrush(const Value: TBrush);
begin
FBrush := Value;
end;
procedure TLogGraph.SetCaption(const Value: String);
begin
FCaption := Value;
end;
procedure TLogGraph.SetPen(const Value: TPen);
begin
FPen := Value;
end;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Log:TLogGraph;
ACurve:TCurve;
s,s1:TPointArray;
I:Integer;
begin
Log:=TLogGraph.Create(Form1);
Log.Parent:=Form1;
Log.Left:=10;
Log.Top:=10;
Log.Width :=500;
Log.Height:=500;
SetLength(s,100);
for i:=0 to 99 do
begin
s.x:=i;
s.y:=i*2;
end;
SetLength(s1,100);
for i:=0 to 99 do
begin
s1.x:=i;
s1.y:=trunc(abs(sin(i))*50)+50;
end;
ACurve:=TCurve.Create(Log.Curves);
Log.Curves[0].PointArray:=S;
Log.Curves.Add ;
Log.Curves[1].PointArray :=s1 ;
Log.BorderStyle:=bsSingle;
Log.Paint;
end;
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,tmpYouble;
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);
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;