procedure MyMouseMove(Shift:TShiftState;x,y:integer);dynamic;
Procedure WMMyMessage(var Mes:TMessage); message WM_MyMessage;
public
{ Public declarations }
constructor create(AOwner:TComponent);override;
destructor Destroy; override;
procedure AddValue(value:TPoint);overload;
function GetPointsCount:Longint; //читає точку
function getList:TPointArray;
function SaveData(filename:String):integer;
function LoadData(filename:String):integer;
function SavePicture(filename:String):integer;
procedure Start;
procedure Stop;
procedure Clear;
procedure Resize(Sender:TControl);
function GetValue(index:Longint): Longint; //читає точку
// procedure AddValue(value:longint);overload;
published
{ Published declarations }
property TypeDiagram:TTypeDiagram read FTypeDiagram write FTypeDiagram;
property DrawCount:integer read FPointDrawCount Write FPointDrawCount;
property DrawX:Boolean read FDrawX Write FDrawX;
property DrawY:Boolean read FDrawY Write FDrawY;
property DrawGridX:Boolean read FDrawGridX Write FDrawGridX;
property DrawGridY:Boolean read FDrawGridY Write FDrawGridY;
property DrawColor:TColor read FDrawColor Write FDrawColor;
property DrawGridColor:TColor read FDrawGridColor Write FDrawGridColor;
property DrawStart:integer read FPointStart Write FPointStart;
property NumSeccondShow:word read FNumSeccond write FNumSeccond stored false;
property NumMiliSec:word read FNumMSeccond write FNumMSeccond stored false;
property OnMouseMove:TnewMouseMoveEvent read FOnMouseMove write FOnMouseMove;
end;
procedure Register;
implementation
procedure TGraphicDiagram.Resize;
begin
Height:=Sender.Height-30;
Width:=Sender.Width-15;
invalidate;
function TGraphicDiagram.getList:TPointArray;
result:=FPointsValue;
procedure TGraphicDiagram.Start;
FDataStart:=now;
procedure TGraphicDiagram.Stop;
FDataStop:=now;
destructor TGraphicDiagram.destroy;
Self.clear;
inherited;
procedure TGraphicDiagram.Clear;
var l:^Longint;
i:TPoint;
n:Longint;
n:=FPointsValue.Count-1;
FPointsValue.clear;
FpointStart:=0;
new (i);
i^:=0;
AddValue(i);
function TGraphicDiagram.LoadData;
var i:Longint;
n:^Longint;
f:textFile;
st:String;
result:=-1;
FpointsValue.Clear;
if not FileExists(filename) then exit;
assignFile(f,filename);
reset(f);
while not eof(f) do
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);
closeFile(f);
result:=0;
function TGraphicDiagram.SavePicture;
var tp:TBitMap;
st:TStream;
p:pointer;
rin:TRect;
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;
function TGraphicDiagram.SaveData;
rewrite(f);
for i:=0 to FPointsValue.count-1 do
n:=FpointsValue.items[i];
writeln(f,DateTimeToStr(FDataStart+(FDataStart-FDataStop)/FPointsValue.count),'|',n^);
function TGraphicDiagram.GetPointsCount:Longint; //
result:=FPointsValue.Count;
procedure TGraphicDiagram.SetTypeDiagram(typeD:TTypeDiagram);
FTypeDiagram:=typeD;
procedure TGraphicDiagram.WMMouseMove(var Mes:TWMMouse);
if not (csNoStdEvents in ControlStyle) then
with mes do MyMouseMove (KeysToShiftState(Keys),Xpos,YPos);
procedure TGraphicDiagram.MyMouseMove(Shift:TShiftState;x,y:integer);
var def:Boolean;
def:=true;
if Assigned(FOnMouseMove) then FOnMouseMove(Self,shift,x,y,def);
{if def then оброблювач по замовчуванню!!!}
procedure TGraphicDiagram.WMMyMessage(var Mes:TMessage);
Canvas.Pen.Color:= clRed;
inValidate;
procedure TGraphicDiagram.DefineProperties(Filer:TFiler);
inherited DefineProperties(Filer);
// Filer.DefineBinaryProperty('TypeDiagram',ReadType,WritePoints,true);
procedure TGraphicDiagram.WritePoints(stream:TStream);
// stream.WriteBuffer(FPointsValue,SizeOf(FPointsVAlue));
procedure TGraphicDiagram.ReadPoints(stream:TStream);
// stream.ReadBuffer(FPointsValue,SizeOf(FPointsVAlue));
constructor TGraphicDiagram.create;
var i:integer;
n:TPoint;
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;
n^:=0;
addValue(n);
FEnabled:=true;
FMashTab:=true; //маштаб по Ігрику
function TGraphicDiagram.getValue;
if index<FPointsValue.count then
Result:=Longint(FPointsValue.items[index])
else result:=0;
procedure TGraphicDiagram.setValue;
l:=FPointsValue.Items[index];
if l<>nil then dispose(l);
FPointsValue.Items[index]:=@value;
if value>FPointYMax then begin
FPointYMax:=Value;
FMashtab:=true;
procedure TGraphicDiagram.AddValue(value:TPoint);
var
knum:Longint;
FPointsValue.Add(value);
knum:=FPointsValue.Count;
if ((knum-FPointStart)+3>FPointDrawCount) then FPointStart:=knum-FPointDrawCount+3;
if value^>FPointYMax then begin
FPointYMax:=Value^;
//Встановлення маштабу по Y
procedure TGraphicDiagram.SetMashtabY;
try
MashtabY:=(Height-30)/FPointYMax;
except MashtabY:=(Height-30)/10 end;
//Встановлення маштабу по X
procedure TGraphicDiagram.SetMashtabX;
MashtabX:=(width-10)/FPointDrawCount;
procedure TGraphicDiagram.paint;
var i:longint;
//Отримання координати Х точки у відповідності до маштабу по Х
function GetX(p:longint):integer;
result:=10 + Round(p*MashtabX);
//Отримання координати Y точки у відповідності до маштабу по Y
function GetY(p:longint):integer;
result:=Height -10 - Round(p*MashtabY);
procedure drawKoordinate;
temp:TColor;
with canvas do
//Відобрахкння координатних осей
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);
lineTo(width-15,height-5);
//Поділки на вісі Х
for i:=0 to 9 do
moveTo(10+(width) div 10 *i,height-5);
lineTo(10+(width) div 10 *i,height-15);
//Вісь Y
if FDrawY then begin
lineTo(10,5);
moveTo(10,5);
lineTo(5,15);
lineTo(15,15);
//Поділки на вісі Y
moveTo(5,height-10- height div 10*i);
lineTo(15,height-10- height div 10*i);
pen.Width:=1;
pen.Style:=psDot;
pen.Color:=FDrawGridColor;
//Відображення координатної сітки
if FDrawGridX then
//Сітка по вісі Х
lineTo(10+(width) div 10 *i,0);
if FDrawGridY then begin
//Сітка по вісі Y
lineTo(width,height-10- height div 10*i);
pen.style:=psSolid;
pen.Color:=temp;
var l:longint;
p:^Longint;
rx:longint;
ry:longint;
if FMashtab then
SetMashtabX;
SetMashtabY;
if csDesigning in ComponentState then
inherited Canvas.pen.Style:= psDash
else
inherited Canvas.pen.Style:= psSolid;
l:=FPointsValue.Count-1;
with inherited Canvas do
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
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;
FillRect(Rect(rx,Height-10,rx+1,ry));
RegisterComponents('ActiveX', [TGraphicDiagram]);
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 }
Form3: TForm3;
uses MainForm;
{$R *.dfm}
procedure TForm3.FormShow(Sender: TObject);
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;
procedure TForm3.BitBtn1Click(Sender: TObject);
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;
Страницы: 1, 2, 3, 4, 5, 6, 7, 8