p align="left">form3.Show; end; procedure TForm1.N6Click(Sender: TObject); begin // form4.show; end; procedure TForm1.AboutClick(Sender: TObject); begin aboutbox.showmodal; end; procedure TForm1.newGraphicExecute(Sender: TObject); begin form1.ItemNewClick(self); end; procedure TForm1.ExitPrExecute(Sender: TObject); begin close; end; procedure TForm1.StartGrExecute(Sender: TObject); begin ScrollBar1.Enabled:=false; Fileitem.Enabled:=false; // Interpolation.Enabled:=false; Options.Enabled:=false; SpeedButton1.Enabled:=false; SpeedButton2.Enabled:=false; SpeedButton3.Enabled:=false; Timer1.Interval:=GraphicDiagram1.NumMiliSec; Timer1.Enabled:=True; Pause.Enabled:=true; SpeedButton5.Enabled:=true; end; procedure TForm1.StopGrExecute(Sender: TObject); begin if GraphicDiagram1.GetPointsCount>GraphicDiagram1.DrawCount then begin ScrollBar1.Enabled:=true; ScrollBar1.SetParams(GraphicDiagram1.GetPointsCount,0,GraphicDiagram1.GetPointsCount); end; Fileitem.Enabled:=true; // Interpolation.Enabled:=true; Options.Enabled:=true; SpeedButton1.Enabled:=true; SpeedButton2.Enabled:=true; SpeedButton3.Enabled:=true; Timer1.Enabled:=false; Pause.Enabled:=false; end; procedure TForm1.SaveGraphExecute(Sender: TObject); begin SavePictureClick(Sender); end; procedure TForm1.saveDataGrExecute(Sender: TObject); begin if SaveDialog1.Execute then GraphicDiagram1.SaveData(SaveDialog1.FileName); end; procedure TForm1.HelpPrExecute(Sender: TObject); begin aboutBox.ShowModal; end; procedure TForm1.LoadDataGRExecute(Sender: TObject); begin if openDialog1.Execute then begin if fileExists (openDialog1.FileName) then GraphicDiagram1.LoadData(openDialog1.FileName) else messageDlg('Немає такого файлу!!',mtError,[mbOk],0); end; end; procedure TForm1.BitBtn1Click(Sender: TObject); begin try GraphicDiagram1.NumMiliSec:=StrToInt(Edit16.Text); except MessageDlg('Число повинне бути цілим та додатнім!!!',mtError,[mbOk],0); end end; procedure TForm1.GeneratorOptionClick(Sender: TObject); begin Form4.showmodal; end; end. Текст компонента GraphicDiagram unit GraphicDiagram; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs; const WM_MYMessage = WM_USER+1000; const MAX_COUNT = 10000; type TTypeDiagram = (tdLine,tdColumn,tdUser); TPoint = ^Longint; TPointArray = TList; TCount = 0..MAX_COUNT; TnewMouseMoveEvent = procedure (Sender:TObject;Shift:TShiftState;x,y:integer; var DoDefault:boolean) of Object; TGraphicDiagram = class(TGraphicControl) private FTypeDiagram:TTypeDiagram; FpointStart:Longint;//початок відображення точок на графіку FPointDrawCount:Longint; //Кінець відображення точок на графіку FNumSeccond,FNumMSeccond:word; // кількість мілісекунд, після яких добавляється точка FPointYMax:Longint; //максимальна точка по Ігрик FDrawX:Boolean; FDrawY:Boolean; FDRAWColor:TColor; FDrawGridX:Boolean; FDrawGridY:Boolean; FDrawGridColor:TColor; FPointsValue:TPointArray; // тільки додатні елементи FDataStart,FDataStop:TDateTime;//початок відображення точок на графіку FEnabled:Boolean; FOnMouseMove:TnewMouseMoveEvent; OurTime:longint; MashtabX:real; MashtabY:real; FMashTab:Boolean; //маштаб якщо він змінився то true // function GetValue(index:Longint): Longint; //читає точку Procedure SetValue(index,value:Longint); //добавляє точку procedure SetTypeDiagram(typeD:TTypeDiagram); procedure SetMashtabX; procedure SetMashtabY; protected procedure paint;override; procedure WritePoints(stream:TStream);virtual; procedure ReadPoints(stream:TStream);virtual; procedure DefineProperties(Filer:TFiler);override; procedure WMMouseMove(var Mes:TWMMouse); message WM_MOUSEMOVE; 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; end; function TGraphicDiagram.getList:TPointArray; begin result:=FPointsValue; end; procedure TGraphicDiagram.Start; begin FDataStart:=now; end; procedure TGraphicDiagram.Stop; begin FDataStop:=now; end; destructor TGraphicDiagram.destroy; begin Self.clear; inherited; end; procedure TGraphicDiagram.Clear; var l:^Longint; i:TPoint; n:Longint; begin n:=FPointsValue.Count-1; FPointsValue.clear; FpointStart:=0; new (i); i^:=0; AddValue(i); invalidate; end; function TGraphicDiagram.LoadData; var i:Longint; n:^Longint; f:textFile; 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.
Страницы: 1, 2, 3, 4, 5, 6
|