st:String;
begin
result:=-1;
FpointsValue.Clear;
FpointStart:=0;
if not FileExists(filename) then exit;
assignFile(f,filename);
reset(f);
while not eof(f) do
begin
readln(f,st);
i:=pos('|',st);
if i=0 then Exception.create('Неправильний формат файлу '+filename);
FDataStart:=StrToDateTime(copy(st,1,i-1));
new (n);
n^:= StrToInt(copy(st,i+1,10));
FpointsValue.add(n);
end;
closeFile(f);
invalidate;
result:=0;
end;
function TGraphicDiagram.SavePicture;
var tp:TBitMap;
st:TStream;
p:pointer;
rin:TRect;
begin
rin:=Rect(0,0,width,height);
//TCanvas
tp:= TBitmap.Create;
// p:=addr(self.canvas.pixels[0,0])
tp.width:=width;
tp.height:=height;
tp.canvas.CopyRect (rin, self.canvas,rin);
tp.SaveToFile (filename);
tp.free;
end;
function TGraphicDiagram.SaveData;
var i:Longint;
n:^Longint;
f:textFile;
begin
result:=-1;
assignFile(f,filename);
rewrite(f);
for i:=0 to FPointsValue.count-1 do
begin
n:=FpointsValue.items[i];
writeln(f,DateTimeToStr(FDataStart+(FDataStart-FDataStop)/FPointsValue.count),'|',n^);
end;
closeFile(f);
result:=0;
end;
function TGraphicDiagram.GetPointsCount:Longint; //
begin
result:=FPointsValue.Count;
end;
procedure TGraphicDiagram.SetTypeDiagram(typeD:TTypeDiagram);
begin
FTypeDiagram:=typeD;
invalidate;
end;
procedure TGraphicDiagram.WMMouseMove(var Mes:TWMMouse);
begin
inherited;
if not (csNoStdEvents in ControlStyle) then
with mes do MyMouseMove (KeysToShiftState(Keys),Xpos,YPos);
end;
procedure TGraphicDiagram.MyMouseMove(Shift:TShiftState;x,y:integer);
var def:Boolean;
begin
def:=true;
if Assigned(FOnMouseMove) then FOnMouseMove(Self,shift,x,y,def);
{if def then оброблювач по замовчуванню!!!}
end;
procedure TGraphicDiagram.WMMyMessage(var Mes:TMessage);
begin
Canvas.Pen.Color:= clRed;
inValidate;
end;
procedure TGraphicDiagram.DefineProperties(Filer:TFiler);
begin
inherited DefineProperties(Filer);
// Filer.DefineBinaryProperty('TypeDiagram',ReadType,WritePoints,true);
end;
procedure TGraphicDiagram.WritePoints(stream:TStream);
begin
// stream.WriteBuffer(FPointsValue,SizeOf(FPointsVAlue));
end;
procedure TGraphicDiagram.ReadPoints(stream:TStream);
begin
// stream.ReadBuffer(FPointsValue,SizeOf(FPointsVAlue));
end;
constructor TGraphicDiagram.create;
var i:integer;
n:TPoint;
begin
inherited create (AOwner);
FDrawColor:=clBlack;
FDrawGridColor:=clBlack;
FDrawX:=true;
FDrawY:=true;
FDrawGridX:=true;
FDrawGridY:=true;
FPointYMax:=1;
Height:=100;
Width:=200;
FNumSeccond:=20;
FNumMSeccond:=200;
FPointDrawCount:=(FNumSeccond*1000) div FNumMSeccond;
MashtabX:=Width/FPointDrawCount;
MashtabY:=(Height-30);
FTypeDiagram:= tdColumn;
FPointsValue:=TList.Create;
new (n);
n^:=0;
addValue(n);
FEnabled:=true;
FMashTab:=true; //маштаб по Ігрику
end;
function TGraphicDiagram.getValue;
begin
if index<FPointsValue.count then
Result:=Longint(FPointsValue.items[index])
else result:=0;
end;
procedure TGraphicDiagram.setValue;
var l:^Longint;
begin
if index<FPointsValue.count then
begin
l:=FPointsValue.Items[index];
if l<>nil then dispose(l);
FPointsValue.Items[index]:=@value;
if value>FPointYMax then begin
FPointYMax:=Value;
FMashtab:=true;
end;
invalidate;
end;
end;
procedure TGraphicDiagram.AddValue(value:TPoint);
var
knum:Longint;
begin
FPointsValue.Add(value);
knum:=FPointsValue.Count;
if ((knum-FPointStart)+3>FPointDrawCount) then FPointStart:=knum-FPointDrawCount+3;
if value^>FPointYMax then begin
FPointYMax:=Value^;
FMashtab:=true;
end;
invalidate;
end;
//Встановлення маштабу по Y
procedure TGraphicDiagram.SetMashtabY;
begin
try
MashtabY:=(Height-30)/FPointYMax;
except MashtabY:=(Height-30)/10 end;
end;
//Встановлення маштабу по X
procedure TGraphicDiagram.SetMashtabX;
begin
MashtabX:=(width-10)/FPointDrawCount;
end;
procedure TGraphicDiagram.paint;
var i:longint;
//Отримання координати Х точки у відповідності до маштабу по Х
function GetX(p:longint):integer;
begin
result:=10 + Round(p*MashtabX);
end;
//Отримання координати Y точки у відповідності до маштабу по Y
function GetY(p:longint):integer;
begin
result:=Height -10 - Round(p*MashtabY);
end;
procedure drawKoordinate;
var i:integer;
temp:TColor;
begin
with canvas do
begin
//Відобрахкння координатних осей
pen.Width:=2;
temp:=pen.Color;
pen.Color:=FDrawColor;
//Вісь Х
if FDrawX then begin
moveTo(10,height-10);
lineTo(width-5,height-10);
moveTo(width-5,height-10);
lineTo(width-15,height-15);
moveTo(width-5,height-10);
lineTo(width-15,height-5);
//Поділки на вісі Х
for i:=0 to 9 do
begin
moveTo(10+(width) div 10 *i,height-5);
lineTo(10+(width) div 10 *i,height-15);
end;
end;
//Вісь Y
if FDrawY then begin
moveTo(10,height-10);
lineTo(10,5);
moveTo(10,5);
lineTo(5,15);
moveTo(10,5);
lineTo(15,15);
//Поділки на вісі Y
for i:=0 to 9 do
begin
moveTo(5,height-10- height div 10*i);
lineTo(15,height-10- height div 10*i);
end;
end;
moveTo(10,height-10);
pen.Width:=1;
pen.Style:=psDot;
pen.Color:=FDrawGridColor;
//Відображення координатної сітки
if FDrawGridX then
begin
//Сітка по вісі Х
for i:=0 to 9 do
begin
moveTo(10+(width) div 10 *i,height-5);
lineTo(10+(width) div 10 *i,0);
end;
end;
if FDrawGridY then begin
//Сітка по вісі Y
for i:=0 to 9 do
begin
moveTo(5,height-10- height div 10*i);
lineTo(width,height-10- height div 10*i);
end;
end;
moveTo(10,height-10);
pen.style:=psSolid;
pen.Color:=temp;
end;
end;
var l:longint;
p:^Longint;
rx:longint;
ry:longint;
begin
if FMashtab then
begin
SetMashtabX;
SetMashtabY;
end;
if csDesigning in ComponentState then
inherited Canvas.pen.Style:= psDash
else
inherited Canvas.pen.Style:= psSolid;
l:=FPointsValue.Count-1;
with inherited Canvas do
begin
Brush.Style:=bsClear;
// Rectangle(0,0,Width,Height);
p:=FPointsValue.items[FPointStart];
moveTo(0,GetY(p^));
pen.Style:= psSolid;
pen.color:=clBlack;
DrawKoordinate;
if FTypeDiagram=tdLine then
for i:=FPointStart to l do
begin
p:=FPointsValue.items[i];
rx:=GetX(i-FPointStart);
ry:=GetY(p^);
LineTo(rx,ry)
end
else if FTypeDiagram=tdColumn then begin
Brush.Style:= bsSolid;
Brush.Color:= clBlue;
for i:=FPointStart to l do
begin
p:=FPointsValue.items[i];
rx:=GetX(i-FPointStart);
ry:=GetY(p^);
FillRect(Rect(rx,Height-10,rx+1,ry));
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('ActiveX', [TGraphicDiagram]);
end;
end.
Текст модуля Unit3
unit Unit3;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Dialogs, ComCtrls, StdCtrls, Buttons, ExtCtrls;
type
TForm3 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
GroupBox1: TGroupBox;
RBX: TRadioButton;
RBY: TRadioButton;
RbXY: TRadioButton;
RBNone: TRadioButton;
GroupBox2: TGroupBox;
RBGX: TRadioButton;
RBGY: TRadioButton;
RBGXY: TRadioButton;
RBGNone: TRadioButton;
ColorBox1: TColorBox;
ColorBox2: TColorBox;
procedure FormShow(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form3: TForm3;
implementation
uses MainForm;
{$R *.dfm}
procedure TForm3.FormShow(Sender: TObject);
begin
with Form1 do
if GraphicDiagram1.DrawX and GraphicDiagram1.DrawY then RBXY.Checked:=true else
if GraphicDiagram1.DrawX then RBX.Checked:=true else
if GraphicDiagram1.DrawY then RBY.Checked:=true else
RBNONe.Checked:=true;
end;
procedure TForm3.BitBtn1Click(Sender: TObject);
begin
with Form1 do begin
//Перевірка для осей координат
if RBXY.Checked then begin GraphicDiagram1.DrawX:=true; GraphicDiagram1.DrawY:=true;end;
if RBY.Checked then begin GraphicDiagram1.DrawX:=false; GraphicDiagram1.DrawY:=true;end;
if RBX.Checked then begin GraphicDiagram1.DrawX:=true; GraphicDiagram1.DrawY:=false;end;
if RBNone.Checked then begin GraphicDiagram1.DrawX:=false; GraphicDiagram1.DrawY:=false;end;
//Перевірка для сітки
if RBGXY.Checked then begin GraphicDiagram1.DrawGridX:=true; GraphicDiagram1.DrawGridY:=true;end;
if RBGY.Checked then begin GraphicDiagram1.DrawGridX:=false; GraphicDiagram1.DrawGridY:=true;end;
if RBGX.Checked then begin GraphicDiagram1.DrawGridX:=true; GraphicDiagram1.DrawGridY:=false;end;
if RBGNone.Checked then begin GraphicDiagram1.DrawGridX:=false; GraphicDiagram1.DrawGridY:=false;end;
GraphicDiagram1.DrawColor:=ColorBox2.Selected;
GraphicDiagram1.DrawGridColor:=ColorBox1.Selected;
GraphicDiagram1.Invalidate;
end;
end;
end.