47011 (588460), страница 6

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 6)

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

Result:=Longint(FPointsValue.items[index])

else result:=0;

end;

procedure TGraphicDiagram.setValue;

var l:^Longint;

begin

if index

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.

Характеристики

Список файлов ВКР