Chip 2001 December

home *** CD-ROM | disk | FTP | other *** search

/ Chip 2001 December / Chip_2001-12_cd1.bin / zkuste / delphi / kolekce / d56 / DM2KVCL.ZIP / PLOT.PAS < prev next >

Wrap

Pascal/Delphi Source File | 2001-03-05 | 70.0 KB | 1,658 lines

{****************************************************************************} { Data Master 2000 } {****************************************************************************} unit Plot; {$B-,X+} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ExtCtrls, ClipBrd, Printers, Common, Data, Parser; type TPointType=(ptSquare, ptCircle, ptCross, ptXCross, ptAsterisk); {shape type} const {there's many series in the plot! so dfm size will be greatly reduced} DefLineVisible=true; DefShowBestFit=false; DefXColumn=0; DefYColumn=0; DefFirstLine=0; DefLastLine=-1; DefPointSize=5; DefPointVisible=true; DefInterleave=1; DefPointType=ptSquare; DefIsFunction=false; type TPlot = class; {note that forward and define type declarations MUST be in the same <type> section! Else D5 produce weird error messages...} TAxis=class(TPersistent) {axis attributes} private FPlot: TPlot; FWidth, FDecimals: integer; FFType: TFloatFormat; FMin, FMax, FMargins: extended; FPen: TPen; FFont: TFont; FMajorTicks,FMinorTicks: integer; FAutoScale: boolean; FShowGrid: boolean; FTitle: string; FExpression: string; procedure OnChanged(Sender: TObject); {called by font/brush when changed} procedure SetMin(M: extended); procedure SetMax(M: extended); procedure SetPen(P: TPen); procedure SetFont(F: TFont); procedure SetMinorTicks(T: integer); procedure SetMajorTicks(T: integer); procedure SetWidth(W: integer); procedure SetDecimals(D: integer); procedure SetFType(T: TFloatFormat); procedure SetFormat(F: TFormat); function GetFormat: TFormat; procedure SetAutoScale(A: boolean); procedure SetShowGrid(G: boolean); procedure SetMargins(M: extended); procedure SetTitle(T: string); procedure SetExpression(const Value: string); procedure Update; {called by Changed() and when properties changed} public property Format: TFormat read GetFormat write SetFormat; procedure Assign(A: TPersistent); override; constructor Create(APlot: TPlot); destructor Destroy; override; published property Min: extended read FMin write SetMin; property Max: extended read FMax write SetMax; property Pen: TPen read FPen write SetPen; property Font: TFont read FFont write SetFont; property MinorTicks: integer read FMinorTicks write SetMinorTicks; property MajorTicks: integer read FMajorTicks write SetMajorTicks; property LabelWidth: integer read FWidth write SetWidth; property LabelDecimals: integer read FDecimals write SetDecimals; property LabelType: TFloatFormat read FFType write SetFType; property AutoScale: boolean read FAutoScale write SetAutoScale; property ShowGrid: boolean read FShowGrid write SetShowGrid; property Margins: extended read FMargins write SetMargins; property Title: string read FTitle write SetTitle; property Expression: string read FExpression write SetExpression; end; TSerie=class(TCollectionItem) {serie attributes} private FText: string; FPointType: TPointType; FPointVisible,FLineVisible,FShowBestFit,FIsFunction: boolean; FXColumn,FYColumn,FFirstLine,FLastLine,FInterleave: integer; FPointSize: integer; FPen: TPen; FBrush: TBrush; FXExpression, FYExpression: string; FContainer: TContainer; procedure OnChanged(Sender: TObject); {called by font/brush when changed} procedure SetPointType(T: TPointType); {methods for properties} procedure SetPointVisible(B: boolean); procedure SetLineVisible(B: boolean); procedure SetIsFunction(B: boolean); procedure SetXColumn(X: integer); procedure SetYColumn(Y: integer); procedure SetFirstLine(F: integer); procedure SetLastLine(L: integer); procedure SetPointSize(S: integer); procedure SetInterleave(I: integer); procedure SetShowBestFit(B: boolean); procedure SetPen(P: TPen); procedure SetBrush(B: TBrush); procedure SetXExpression(E: string); procedure SetYExpression(E: string); procedure SetContainer(C: TContainer); procedure SetText(Value: string); protected function GetDisplayName: string; override; public X1,X2,Y1,Y2,bfA,bfB: extended; {need for BestFit & scale info} Scaled: boolean; {set by Plot.Paint() if serie scale info ^ is valid} Locked: boolean; {used to add points without repainting whole plot} constructor Create(Collection: TCollection); override; destructor Destroy; override; procedure Assign(Source: TPersistent); override; function Empty: boolean; {true, if block is empty} procedure ClearBlock; {set block coords to 0} published property PointType: TPointType read FPointType write SetPointType default DefPointType; property PointVisible: boolean read FPointVisible write SetPointVisible default DefPointVisible; property PointSize: integer read FPointSize write SetPointSize default DefPointSize; property LineVisible: boolean read FLineVisible write SetLineVisible default DefLineVisible; property FirstLine: integer read FFirstLine write SetFirstLine default DefFirstLine; property LastLine: integer read FLastLine write SetLastLine default DefLastLine; property Interleave: integer read FInterleave write SetInterleave default DefInterleave; property ShowBestFit: boolean read FShowBestFit write SetShowBestFit default DefShowBestFit; property IsFunction: boolean read FIsFunction write SetIsFunction default DefIsFunction; property XColumn: integer read FXColumn write SetXColumn default DefXColumn; property YColumn: integer read FYColumn write SetYColumn default DefYColumn; property Pen: TPen read FPen write SetPen; property Brush: TBrush read FBrush write SetBrush; property Text: string read FText write SetText; property XExpression: string read FXExpression write SetXExpression; property YExpression: string read FYExpression write SetYExpression; property Container: TContainer read FContainer write SetContainer; end; TSeries=class(TCollection) {array of plot series} private FPlot: TPlot; function GetItem(Index: Integer): TSerie; procedure SetItem(Index: Integer; Value: TSerie); protected function GetOwner: TPersistent; override; procedure Update(Item: TCollectionItem); override; public constructor Create(APlot: TPlot); function Add: TSerie; property Items[Index: Integer]:TSerie read GetItem write SetItem; default; property Plot: TPlot read FPlot; end; TPlotHintEvent=procedure(Sender: TObject; H: string) of object; TGetPointEvent=function(D:TData; CX,CY:integer; const XExpr,YExpr: string; var X,Y:extended): boolean of object; TClickedAt=(claPlot, claXAxis, claYAxis); TPlotMouseMode=(pmNone, pmAutoZoom, pmZoom, pmRuler, pmUnZoom, pmSelect, pmPointClick, pmPointEdit, pmPointDelete, pmTranslate); TPlotCopyMode=(pcmPage, pcmPoints, pcmItems); TTranslateMode=(ptmNo,ptmL,ptmR,ptmB,ptmT,ptmTL,ptmTR,ptmBL,ptmBR,ptmMove); TPointClickEvent=procedure(Sender:TObject; Point,Serie:integer) of object; TPlot = class(TPaintBox) private { Private declarations } FPen: TPen; FBrush: TBrush; FSerieIndex: integer; FXAxis, FYAxis: TAxis; FSeries: TSeries; FBorderStyle: TBorderStyle; FClickedAt: TClickedAt; FTransparent: boolean; FOnHint,FOnError: TPlotHintEvent; FGetPoint: TGetPointEvent; FOnSelectionChange: TNotifyEvent; FOnPointClick: TPointClickEvent; FParser: TMathParser; {these 2 need for parsing serie's X,YExpressions} FParserParams: TRealArray; FMouseMode: TPlotMouseMode; {determine how mouse is used} {next integer variables used together by Paint() and RealToIntCoords()!!!} XAxisGap, YAxisGap, XLabelW, XTickLen, YTickLen, XLabelH, YLabelW, YLabelH, XAxisLen, YAxisLen: integer; Zooming: boolean; {next 5 fields used for zoom} ZoomX,ZoomY,ZoomXo,ZoomYo: integer; Ruling: boolean; {flag of using ruler} RulerX,RulerY: integer; {ruler center coords} RulerFi: extended; {ruler angle} FCanvas: TCanvas; {buffer used from Paint} FWidth, FHeight: integer; {used for printing in Paint} Printing: boolean; {-#-} FCanUnZoom: boolean; {these vars needed for Undo Zoom} OldX1,OldX2,OldY1,OldY2, {Undo buffers for previous coordinates} FX,FY,FN,FNA: TReal; {buffers for X,Y,Num,AbsNum expression parameters} Editing: boolean; {these nine used by point editor} EditX, EditY, EditX1, EditY1, EditX2, EditY2, EditSer, EditPnt: integer; FSelectionVisible: boolean; {these 5 keep selection properties} FSelectionTop,FSelectionBottom,FSelectionLeft,FSelectionRight: extended; Translating: TTranslateMode; {keep selection translation mode} TransX1,TransX2,TransY1,TransY2: extended; {keep old selection coordinate} TransBuf: array of TRealPoint; {next 2 used to paint translation preview} TransPointCount: integer; function BelongMarker(rX,rY: extended; X,Y: integer): boolean; procedure DrawSelection; procedure SetXAxis(Value: TAxis); procedure SetYAxis(Value: TAxis); procedure SetSeries(const Value: TSeries); procedure SetBorderStyle(B: TBorderStyle); procedure SetTransparent(B: boolean); procedure Changed(Sender: TObject); {called indirectly by canvas, axes,..} procedure DrawRuler(X,Y: integer); {show/hide ruler} procedure DrawEdit(X,Y: integer); {used by point editor} procedure SetSerieIndex(const Value: integer); function GetThisSerie: TSerie; function GetSelection(const Index: Integer): extended; procedure SetSelection(const Index: Integer; const Value: extended); procedure SetSelectionVisible(const Value: boolean); procedure SetPen(P: TPen); procedure SetBrush(B: TBrush); procedure SetMouseMode(M: TPlotMouseMode); protected { Protected declarations } procedure Paint; override; {paints plot} procedure ShowPlotHint(H: string); virtual; procedure ShowPlotError(H: string); virtual; procedure MouseDown(Btn: TMouseButton; {add zoom & other functions} Shift: TShiftState; X,Y: Integer); override; procedure MouseUp(Btn: TMouseButton; Shift: TShiftState; X,Y: Integer); override; procedure MouseMove(Shift: TShiftState; X,Y: Integer); override; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; function GetDataPoint(D: TData; CX,CY: integer; const XExpr,YExpr: string; var X,Y: extended): boolean; virtual; procedure SetDataPoint(D: TData; CX,CY: integer; X,Y: extended); virtual; {these 2 methods may be overridden for custom datatype support!!! } procedure DrawLine(X1,Y1,X2,Y2: extended); {drawing methods} procedure DrawPoint(X,Y: extended; T: TPointType; S: integer); procedure PaintPoint(X,Y: integer; T: TPointType; S: integer; C: TCanvas); function RealToIntCoords(X, Y: extended; var iX,iY: integer): boolean; function IntToRealCoords(X,Y:integer; var rX,rY: extended): boolean; procedure CopyToClipboard(Mode: TPlotCopyMode; UseTabs: boolean); procedure Delete; {delete items from selected area} procedure Print(W,H: integer); {prints plot} procedure UndoZoom; {restore coordinates changed by built-in Zoom} property ClickedAt: TClickedAt read FClickedAt; {for use in OnClick} property Parser: TMathParser read FParser; {may add some parameters} property CanUnZoom: boolean read FCanUnZoom; {true when undo possible} procedure SaveToFile(FileName: string); procedure SaveToMetafile(WMF: TMetafile); property SelectionVisible: boolean read FSelectionVisible write SetSelectionVisible; {if true, selection painted} property SelectionTop: extended index 1 read GetSelection write SetSelection; property SelectionBottom: extended index 2 read GetSelection write SetSelection; property SelectionLeft: extended index 3 read GetSelection write SetSelection; property SelectionRight: extended index 4 read GetSelection write SetSelection; published { Published declarations } property Pen: TPen read FPen write SetPen; property Brush: TBrush read FBrush write SetBrush; property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle; property MouseMode: TPlotMouseMode read FMouseMode write SetMouseMode default pmNone; property Transparent: boolean read FTransparent write SetTransparent default true; property XAxis: TAxis read FXAxis write SetXAxis; property YAxis: TAxis read FYAxis write SetYAxis; property Series: TSeries read FSeries write SetSeries; property SerieIndex: integer read FSerieIndex write SetSerieIndex; property ThisSerie: TSerie read GetThisSerie stored false; property OnHint: TPlotHintEvent read FOnHint write FOnHint; property OnError: TPlotHintEvent read FOnError write FOnError; property OnGetPoint: TGetPointEvent read FGetPoint write FGetPoint; property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange; property OnPointClick: TPointClickEvent read FOnPointClick write FOnPointClick; end; procedure Register; resourcestring errSerieBlock='Invalid data range in serie %d!'; errSerieExpr='Parsing error in serie %d: %s'; errSerieCols='Missed data in serie %d, line %d!'; msgScaling='Scaling...'; msgPlotting='Plotting...'; msgScanning='Scanning data...'; strMoving='Moving points...'; errEditPoint1='Unable to move point: serie %d has nonempty %s expression!'; errEditPoint2='Unable to move point: %s axis has nonempty expression!'; errTranslation='Unable to translate points: nonempty expressions!'; implementation const PPI=85; {points per inch; => [w,pel]=[pel/"]/[Pnt/"]*[w,pnt]} MSZ=5; {selection marker size} { TAxis } procedure TAxis.OnChanged(Sender: TObject); begin Update; end; procedure TAxis.Update; begin if Assigned(FPlot) then FPlot.Changed(Self); end; procedure TAxis.Assign(A: TPersistent); begin if A is TAxis then begin LabelWidth:=(A as TAxis).LabelWidth; LabelDecimals:=(A as TAxis).LabelDecimals; LabelType:=(A as TAxis).LabelType; Min:=(A as TAxis).Min; Max:=(A as TAxis).Max; Pen.Assign((A as TAxis).Pen); Font.Assign((A as TAxis).Font); MajorTicks:=(A as TAxis).MajorTicks; MinorTicks:=(A as TAxis).MinorTicks; AutoScale:=(A as TAxis).AutoScale; ShowGrid:=(A as TAxis).ShowGrid; Margins:=(A as TAxis).Margins; Title:=(A as TAxis).Title; Expression:=(A as TAxis).Expression; end else inherited Assign(A); end; procedure TAxis.SetMin(M: extended); begin if M<>FMin then begin FMin:=M; Update; end; end; procedure TAxis.SetMax(M: extended); begin if M<>FMax then begin FMax:=M; Update; end; end; procedure TAxis.SetPen(P: TPen); begin FPen.Assign(P); end; procedure TAxis.SetFont(F: TFont); begin FFont.Assign(F); end; procedure TAxis.SetMinorTicks(T: integer); begin if (T>1) and (T<50) and (T<>FMinorTicks) then begin FMinorTicks:=T; Update; end; end; procedure TAxis.SetMajorTicks(T: integer); begin if (T>1) and (T<50) and (T<>FMajorTicks) then begin FMajorTicks:=T; Update; end; end; procedure TAxis.SetWidth(W: integer); begin if FWidth<>W then begin FWidth:=W; Update; end; end; procedure TAxis.SetDecimals(D: integer); begin if D<>FDecimals then begin FDecimals:=D; Update; end; end; procedure TAxis.SetFType(T: TFloatFormat); begin if T<>FFType then begin FFType:=T; Update; end; end; procedure TAxis.SetFormat(F: TFormat); begin LabelWidth:=F.Width; LabelDecimals:=F.Decimals; LabelType:=F.FType; end; function TAxis.GetFormat; begin with Result do begin Width:=FWidth; Decimals:=FDecimals; FType:=FFType; end; end; procedure TAxis.SetAutoScale(A: boolean); begin if A<>FAutoScale then begin FAutoScale:=A; Update; end; end; procedure TAxis.SetShowGrid(G: boolean); begin if G<>FShowGrid then begin FShowGrid:=G; Update; end; end; procedure TAxis.SetMargins(M: extended); begin if M<>FMargins then begin FMargins:=M; Update; end; end; procedure TAxis.SetTitle(T: string); begin if T<>FTitle then begin FTitle:=T; Update; end; end; procedure TAxis.SetExpression(const Value: string); begin if FExpression<>Value then begin FExpression:=Value; Update; end; end; constructor TAxis.Create(APlot: TPlot); begin inherited Create; FPlot:=APlot; FWidth:=5; FDecimals:=2; FFType:=ffGeneral; FMin:=0; FMax:=10; FMajorTicks:=10; FMinorTicks:=5; FPen:=TPen.Create; FPen.OnChange:=OnChanged; FFont:=TFont.Create; FFont.OnChange:=OnChanged; FMargins:=0; FAutoScale:=false; FShowGrid:=false; end; destructor TAxis.Destroy; begin FPen.Free; FFont.Free; inherited Destroy; end; { TSerie } constructor TSerie.Create(Collection: TCollection); begin inherited; FPointType:=DefPointType; FPointVisible:=DefPointVisible; FLineVisible:=DefLineVisible; FShowBestFit:=DefShowBestFit; FXColumn:=DefXColumn; FYColumn:=DefYColumn; FFirstLine:=DefFirstLine; FLastLine:=DefLastLine; FPointSize:=DefPointSize; FInterleave:=DefInterleave; FPen:=TPen.Create; FPen.OnChange:=OnChanged; FBrush:=TBrush.Create; FBrush.OnChange:=OnChanged; FXExpression:=''; FYExpression:=''; FContainer:=nil; end; destructor TSerie.Destroy; begin FPen.Free; FBrush.Free; inherited Destroy; end; procedure TSerie.Assign(Source: TPersistent); begin if Source is TSerie then begin {note! we modify properties => Change MAY be called} Text:=TSerie(Source).Text; PointType:=(Source as TSerie).PointType; PointVisible:=(Source as TSerie).PointVisible; LineVisible:=(Source as TSerie).LineVisible; XColumn:=(Source as TSerie).XColumn; YColumn:=(Source as TSerie).YColumn; FirstLine:=(Source as TSerie).FirstLine; LastLine:=(Source as TSerie).LastLine; PointSize:=(Source as TSerie).PointSize; Interleave:=(Source as TSerie).Interleave; ShowBestFit:=(Source as TSerie).ShowBestFit; Pen.Assign((Source as TSerie).Pen); Brush.Assign((Source as TSerie).Brush); Container:=(Source as TSerie).Container; XExpression:=(Source as TSerie).XExpression; YExpression:=(Source as TSerie).YExpression; end else inherited Assign(Source); end; procedure TSerie.OnChanged(Sender: TObject); begin Changed(false); end; function TSerie.GetDisplayName: string; begin Result:=Text; if Result='' then Result:=inherited GetDisplayName; end; procedure TSerie.SetShowBestFit(B: boolean); begin if B<>FShowBestFit then begin FShowBestFit:=B; Changed(false); end; end; procedure TSerie.SetBrush(B: TBrush); begin FBrush.Assign(B); end; procedure TSerie.SetPen(P: TPen); begin FPen.Assign(P); end; procedure TSerie.SetContainer(C: TContainer); begin if FContainer<>C then begin FContainer:=C; Changed(false); end; end; procedure TSerie.SetFirstLine(F: integer); begin if F<>FFirstLine then begin FFirstLine:=F; Changed(false); end; end; procedure TSerie.SetLastLine(L: integer); begin if L<>FLastLine then begin FLastLine:=L; Changed(false); end; end; procedure TSerie.SetInterleave(I: integer); begin if I<>FInterleave then begin FInterleave:=I; Changed(false); end; end; procedure TSerie.SetLineVisible(B: boolean); begin if B<>FLineVisible then begin FLineVisible:=B; Changed(false); end; end; procedure TSerie.SetPointSize(S: integer); begin if S<>FPointSize then begin FPointSize:=S; Changed(false); end; end; procedure TSerie.SetPointType(T: TPointType); begin if T<>FPointType then begin FPointType:=T; Changed(false); end; end; procedure TSerie.SetPointVisible(B: boolean); begin if B<>FPointVisible then begin FPointVisible:=B; Changed(false);end;end; procedure TSerie.SetXColumn(X: integer); begin if X<>FXColumn then begin FXColumn:=X; Changed(false); end; end; procedure TSerie.SetXExpression(E: string); begin if E<>FXExpression then begin FXExpression:=E; Changed(false); end; end; procedure TSerie.SetYColumn(Y: integer); begin if Y<>FYColumn then begin FYColumn:=Y; Changed(false); end; end; procedure TSerie.SetYExpression(E: string); begin if E<>FYExpression then begin FYExpression:=E; Changed(false); end; end; procedure TSerie.SetText(Value: string); begin if FText<>Value then begin FText:=Value; Changed(False); end; end; procedure TSerie.SetIsFunction(B: boolean); begin if B<>FIsFunction then begin FXColumn:=0; FYColumn:=0; FIsFunction:=B; Changed(false); end; end; procedure TSerie.ClearBlock; begin FXColumn:=DefXColumn; FYColumn:=DefYColumn; FFirstLine:=DefFirstLine; FLastLine:=DefLastLine; Changed(false); end; function TSerie.Empty: boolean; begin Result:=(FXColumn<=DefXColumn) or (FYColumn<=DefYColumn) or (FFirstLine<DefFirstLine) or (FLastLine=DefLastLine) or (FLastLine<FFirstLine) or (not Assigned(FContainer)); end; { TSeries } constructor TSeries.Create(APlot: TPlot); begin inherited Create(TSerie); FPlot:=APlot; end; function TSeries.Add: TSerie; begin Result:=TSerie(inherited Add); end; function TSeries.GetItem(Index: Integer): TSerie; begin Result:=TSerie(inherited GetItem(Index)); end; procedure TSeries.SetItem(Index: Integer; Value: TSerie); begin inherited SetItem(Index, Value); end; function TSeries.GetOwner: TPersistent; begin Result:=FPlot; end; procedure TSeries.Update(Item: TCollectionItem); begin if Assigned(FPlot) then if Assigned(Item) then if not ((Item as TSerie).Locked) then FPlot.Changed(Item) else else FPlot.Changed(Self); end; { TPlot } function CorRect(x1,y1,x2,y2: integer): TRect; {check: x1<x2, y1,y2} var i: integer; begin if x1>x2 then begin i:=x1; x1:=x2; x2:=i; end; if y1>y2 then begin i:=y1; y1:=y2; y2:=i; end; Result:=Rect(x1,y1,x2,y2); end; procedure TPlot.Changed(Sender: TObject); begin Zooming:=false; Ruling:=false; Editing:=false; Translating:=ptmNo; Invalidate; end; procedure TPlot.SaveToMetafile(WMF: TMetafile); var WMFC: TMetafileCanvas; begin WMF.Width:=Width; WMF.Height:=Height; try WMFC:=TMetafileCanvas.Create(WMF,0); FCanvas:=WMFC; Paint; FCanvas:=Canvas; Refresh; finally {^ NOTE! here may be a lot of exeptions!} WMFC.Free; end; end; procedure TPlot.SaveToFile(FileName: string); var WMF: TMetafile; begin WMF:=TMetafile.Create; try SaveToMetafile(WMF); WMF.SaveToFile(FileName); finally WMF.Free; end; end; procedure TPlot.CopyToClipboard(Mode: TPlotCopyMode; UseTabs: boolean); var WMF: TMetafile; I,J: integer; S: TStringList; X,Y: TReal; Tab: char; R: string; D: TData; Data: pointer; HData: THandle; MS: TMemoryStream; begin case Mode of pcmPage: begin WMF:=TMetafile.Create; try SaveToMetafile(WMF); Clipboard.Assign(WMF); finally WMF.Free; end; end; pcmPoints,pcmItems: with ThisSerie do begin if Empty then Exit; if UseTabs then Tab:=#9 else Tab:=' '; S:=TStringList.Create; Screen.Cursor:=crHourGlass; MS:=TMemoryStream.Create; J:=0; MS.Write(J, SizeOf(J)); try for I:=FirstLine to LastLine do begin if LastLine<>FirstLine then Container.ShowProgress( // check for /0 Round((I-FirstLine)/(LastLine-FirstLine)*100)); FNA:=I; FN:=I-FirstLine; // enable Num and AbsNum parameters D:=Container.Items[I]; GetDataPoint(D, XColumn, YColumn, XExpression, YExpression, X, Y); if (SelectionLeft<=X) and (SelectionRight>=X) and (SelectionBottom<=Y) and (SelectionTop>=Y) then if Mode=pcmItems then if (D is TRealData) then with D as TRealData do begin // force TAB delimiter!!! R:=''; for J:=1 to Size do R:=R+GetItemText(J)+Tab; S.Add(R); J:=Size; MS.Write(J, SizeOf(J)); for J:=1 to Size do begin X:=RData[J]; MS.Write(X, SizeOf(X)); end; integer(MS.Memory^):=integer(MS.Memory^)+1; end else S.Add(D.Data) else S.Add(FloatToStr(X)+Tab+FloatToStr(Y)); // X,Y-NOT real data! end; ClipBoard.Open; {copy to clipboard} try Clipboard.AsText:=S.Text; if integer(MS.Memory^)>0 then begin HData:=GlobalAlloc(GMEM_MOVEABLE+GMEM_DDESHARE, MS.Size); try Data:=GlobalLock(HData); try Move(MS.Memory^, Data^, MS.Size); SetClipboardData(TRealData.GetClipboardFormat, HData); finally GlobalUnlock(HData); end; except GlobalFree(HData); raise; end; end; finally ClipBoard.Close; end; finally S.Free; MS.Free; Screen.Cursor:=crDefault; end; end;{with} end;{case} end; procedure TPlot.Delete; var J,K,P,DP: integer; X,Y: TReal; M: boolean; begin with ThisSerie do try Screen.Cursor:=crHourGlass; if Empty then Exit; M:=false; K:=FirstLine; P:=0; DP:=LastLine-FirstLine; while K<=LastLine do begin if DP>0 then Container.ShowProgress(Round(P/DP*100)); Inc(P); GetDataPoint(Container.Items[K], XColumn, YColumn, XExpression, YExpression, X, Y); if (SelectionLeft<=X) and (SelectionRight>=X) and (SelectionBottom<=Y) and (SelectionTop>=Y) then begin for J:=0 to Series.Count-1 do {find & correct ALL affected series} if Series[J].Container=Container then with Series[J] do begin if K<=LastLine then LastLine:=LastLine-1; if K<FirstLine then FirstLine:=FirstLine-1; end; with Container do begin TData(Items[K]).Free; Items.Delete(K); end; M:=true; end else Inc(K); end;{while} finally Screen.Cursor:=crDefault; if M then Container.Modified:=true; // only if data really were modified end; end; constructor TPlot.Create(AOwner: TComponent); begin inherited Create(AOwner); FPen:=TPen.Create; FPen.OnChange:=Changed; FBrush:=TBrush.Create; FBrush.OnChange:=Changed; FXAxis:=TAxis.Create(Self); FYAxis:=TAxis.Create(Self); FSeries:=TSeries.Create(Self); FCanvas:=Canvas; {copy "native" canvas to buffer used in Paint()} FParser:=TMathParser.Create; {create and initialize expression parser} with FParser do begin Init(90); AddGonio; AddLogic; AddMath; AddMisc; AddSpec; AddStdParams(@FParserParams); AddObject(@FX,'CX',tfp_realvar); AddObject(@FY,'CY',tfp_realvar); AddObject(@FN,'NUM',tfp_realvar); AddObject(@FNA,'ABSNUM',tfp_realvar); end; Zooming:=false; Ruling:=false; FMouseMode:=pmNone; FSelectionVisible:=false; FTransparent:=true; Editing:=false; FSerieIndex:=-1; Translating:=ptmNo; end; destructor TPlot.Destroy; begin FXAxis.Free; FYAxis.Free; FSeries.Free; FParser.Free; TransBuf:=nil;{!} FPen.Free; FBrush.Free; inherited Destroy; end; procedure TPlot.SetPen(P: TPen); begin FPen.Assign(P); end; procedure TPlot.SetBrush(B: TBrush); begin FBrush.Assign(B); end; procedure TPlot.DrawLine(X1, Y1, X2, Y2: extended); var iX1,iY1,iX2,iY2: integer; {DrawXXX should be called from OnPaint} begin if RealToIntCoords(X1,Y1,iX1,iY1) {invalid coordinates!} or RealToIntCoords(X2,Y2,iX2,iY2) then Exit; FCanvas.MoveTo(iX1, iY1); FCanvas.LineTo(iX2, iY2); end; procedure TPlot.DrawPoint(X, Y: extended; T: TPointType; S: integer); var iX, iY: integer; begin if not RealToIntCoords(X,Y,iX,iY) then PaintPoint(iX,iY,T,S,FCanvas); end; function TPlot.GetDataPoint(D: TData; CX, CY: integer; const XExpr, YExpr: string; var X, Y: extended): boolean; var I: byte; begin if Assigned(FGetPoint) then {may display another datatypes} begin Result:=FGetPoint(D,CX,CY,XExpr,YExpr,X,Y); Exit; end; Result:=true; {true if error!!!} if (D is TFunction) then begin FX:=(D as TFunction).X; FY:=(D as TFunction).Y; {copy to use x,y in exp-s} begin for I:=1 to MaxCols do FParserParams[I]:=1; {cleanup buffer} FParserParams[1]:=(D as TFunction).X; {copy values} FParserParams[2]:=(D as TFunction).Y; end; if XExpr<>'' then X:=FParser.Parse(XExpr) {PARSE...} else if CX=1 then X:=(D as TFunction).X else X:=(D as TFunction).Y; if YExpr<>'' then Y:=FParser.Parse(YExpr) else if CY=1 then Y:=(D as TFunction).X else Y:=(D as TFunction).Y; end else if D is TRealData then begin (D as TRealData).GetRData(FParserParams); FX:=(D as TRealData).RData[CX]; if XExpr<>'' then FX:=FParser.Parse(XExpr); FY:=(D as TRealData).RData[CY]; if YExpr<>'' then FY:=FParser.Parse(YExpr); end else Exit; if XAxis.Expression<>'' then X:=FParser.Parse(XAxis.Expression) else X:=FX; if YAxis.Expression<>'' then Y:=FParser.Parse(YAxis.Expression) else Y:=FY; Result:=false; {NOTE! successfully exit!!!} end; function TPlot.IntToRealCoords(X,Y: integer; var rX,rY: extended): boolean; begin if (X<YAxisGap) or (X>YAxisGap+XAxisLen) or {NOTE: returns TRUE if ok} (Y>FHeight-XAxisGap) or (Y<FHeight-XAxisGap-YAxisLen) then begin Result:=false; Exit; end else Result:=true; with XAxis do rX:=FMin+(X-YAxisGap)/XAxisLen*(FMax-FMin); with YAxis do rY:=FMin+(FHeight-XAxisGap-Y)/YAxisLen*(FMax-FMin); end; function TPlot.BelongMarker(rX,rY: extended; X,Y: integer): boolean; var iX,iY: integer; begin if RealToIntCoords(rX,rY,iX,iY) then Result:=false else Result:=(X>=iX-MSZ) and (X<=iX+MSZ) and (Y>=iY-MSZ) and (Y<=iY+MSZ); end; procedure TPlot.MouseDown(Btn: TMouseButton; Shift:TShiftState; X,Y: Integer); var a,b,rx,ry:extended; Ser,Pnt,ix,iy,I: integer; S: string[3]; begin if X<=YAxisGap then FClickedAt:=claYAxis; if Y>=Height-XAxisGap then FClickedAt:=claXAxis; if (X>YAxisGap) and (Y<Height-XAxisGap) then FClickedAt:=claPlot; inherited MouseDown(Btn, Shift, X, Y); if (ssLeft in Shift) and IntToRealCoords(X,Y,a,b) then {process action:} begin if (MouseMode=pmPointClick) or (MouseMode=pmPointEdit) or (MouseMode=pmPointDelete) then begin {seek for clicked point} Screen.Cursor:=crHourGlass; try ShowPlotHint(msgScanning); {display message} for Ser:=0 to Series.Count-1 do with Series[Ser] do begin if Empty then Continue; {empty serie; goto next} for Pnt:=FirstLine to LastLine do {scan points} begin FNA:=Pnt; FN:=Pnt-FirstLine; if GetDataPoint(Container.Items[Pnt],XColumn,YColumn,XExpression, YExpression, RX, RY) or RealToIntCoords(rx,ry,ix,iy) then Continue else if (abs(x-ix)<=PointSize div 2) and (abs(y-iy)<=PointSize div 2) then begin {FOUND!!!} if Assigned(FOnPointClick) then FOnPointClick(Self,Pnt,Ser); if MouseMode=pmPointDelete then begin for I:=0 to Series.Count-1 do if Series[I].Container=Series[Ser].Container then with Series[I] do // try to correct blocks begin if Pnt<=LastLine then LastLine:=LastLine-1; if Pnt<FirstLine then FirstLine:=FirstLine-1; end; with Series[Ser].Container do begin // free data and delete item TData(Items[Pnt]).Free; Items.Delete(Pnt); Modified:=true; // MessageBeep($ffffffff); end; end;{PointDelete} if MouseMode=pmPointEdit then begin {check for ALL expressions because we can't calculate inverse functions!} if (XAxis.Expression<>'') or (YAxis.Expression<>'') then begin if XAxis.Expression<>'' then S:='X'; if YAxis.Expression<>'' then S:='Y'; if (XAxis.Expression<>'') and (YAxis.Expression<>'') then S:='X,Y'; Screen.Cursor:=crDefault; ShowPlotHint(' '); ShowPlotError(Format(errEditPoint2,[S])); Break; end; if (XExpression<>'') or (YExpression<>'') then begin if XExpression<>'' then S:='X'; if YExpression<>'' then S:='Y'; if (XExpression<>'') and (YExpression<>'') then S:='X,Y'; Screen.Cursor:=crDefault; ShowPlotHint(' '); ShowPlotError(Format(errEditPoint1,[Ser,S])); Break; end; Editing:=true; EditX:=iX; EditY:=iY; {exact coord-s} if Pnt>FirstLine then {remember previous point} begin GetDataPoint(Container.Items[Pnt-1],XColumn, YColumn, XExpression, YExpression, rx, ry); RealToIntCoords(rx,ry,EditX1,EditY1); {NO CHECK!} end else begin EditX1:=0; EditY1:=0; end; {no such!} if Pnt<LastLine then {remember next point} begin GetDataPoint(Container.Items[Pnt+1],XColumn, YColumn, XExpression, YExpression, rx, ry); RealToIntCoords(rx,ry,EditX2,EditY2); end else begin EditX2:=0; EditY2:=0; end; EditSer:=Ser; EditPnt:=Pnt; {use to change point!} DrawEdit(iX,iY); {show "rubber thread"} {MessageBeep($ffffffff); warn user on point capture} end;{PointEdit} Break; end;{find point cycle} end;{for Pnt} if Editing then Break; {prevent capture of >1 point} end;{for Ser} finally Screen.Cursor:=crDefault; ShowPlotHint(' '); end; end;{pointclick process} if ((ssShift in Shift) and (MouseMode=pmAutoZoom)) or {turn on zooming} (MouseMode=pmZoom) or (MouseMode=pmUnZoom) or (MouseMode=pmSelect) then begin {remember first point} Zooming:=true; ZoomX:=X; ZoomY:=Y; ZoomXo:=X; ZoomYo:=Y; end; if MouseMode=pmRuler then {turn on ruling} begin {remember first point} Ruling:=true; RulerX:=X; RulerY:=Y; RulerFi:=0; DrawRuler(X,Y); end; if (ssLeft in Shift) and (MouseMode=pmTranslate) and SelectionVisible then begin if (XAxis.Expression<>'') or (YAxis.Expression<>'') or (ThisSerie.XExpression<>'') or (ThisSerie.YExpression<>'') then ShowPlotError(errTranslation) else if BelongMarker(SelectionLeft,SelectionTop,X,Y) then Translating:=ptmTL else if BelongMarker(SelectionRight,SelectionTop,X,Y) then Translating:=ptmTR else if BelongMarker((SelectionLeft+SelectionRight)/2,SelectionTop,X,Y) then Translating:=ptmT else if BelongMarker((SelectionLeft+SelectionRight)/2,SelectionBottom,X,Y) then Translating:=ptmB else if BelongMarker(SelectionLeft,SelectionBottom,X,Y) then Translating:=ptmBL else if BelongMarker(SelectionRight,SelectionBottom,X,Y) then Translating:=ptmBR else if BelongMarker(SelectionLeft,(SelectionTop+SelectionBottom)/2,X,Y) then Translating:=ptmL else if BelongMarker(SelectionRight,(SelectionTop+SelectionBottom)/2,X,Y) then Translating:=ptmR else if (a>SelectionLeft) and (a<SelectionRight) and (b<SelectionTop) and (b>SelectionBottom) then Translating:=ptmMove else Translating:=ptmNo; ZoomX:=X; ZoomY:=Y; {use the same buffers as for zooming!} TransX1:=FSelectionLeft; TransX2:=FSelectionRight; TransY1:=FSelectionBottom; TransY2:=FSelectionTop; if (Translating<>ptmNo) and (not ThisSerie.Empty) then begin {fill buffer for drawing translation preview} Screen.Cursor:=crHourGlass; try ShowPlotHint(msgScanning); {display message} with ThisSerie do begin SetLength(TransBuf,LastLine-FirstLine+1); TransPointCount:=0; for I:=FirstLine to LastLine do begin GetDataPoint(Container.Items[I],XColumn,YColumn,XExpression, YExpression, rX, rY); if (TransX1<=rX) and (TransX2>=rX) and (TransY1<=rY) and (TransY2>=rY) then begin with TransBuf[TransPointCount] do begin X:=rX; Y:=rY; end; Inc(TransPointCount); end; end; end; finally Screen.Cursor:=crDefault; ShowPlotHint(' '); end; end;{Translating} end;{Translate} end;{if IntToRealCoords()...} end; procedure TPlot.DrawEdit(X, Y: integer); {move "rubber thread"} begin Canvas.Pen.Mode:=pmXor; Canvas.Pen.Style:=psSolid; Canvas.Pen.Width:=1; Canvas.Pen.Color:=Color; if (EditX1<>0) and (EditY1<>0) then begin if (X<>EditX) or (Y<>EditY) {hide previous line if it is not the same} then Canvas.PolyLine([Point(EditX1,EditY1),Point(EditX,EditY)]); Canvas.PolyLine([Point(EditX1,EditY1),Point(X,Y)]); end; if (EditX2<>0) and (EditY2<>0) then begin if (X<>EditX) or (Y<>EditY) then Canvas.PolyLine([Point(EditX2,EditY2),Point(EditX,EditY)]); Canvas.PolyLine([Point(EditX2,EditY2),Point(X,Y)]); end; EditX:=X; EditY:=Y; Canvas.Pen.Mode:=pmCopy; {we need to restore ONLY pen mode} end; procedure TPlot.MouseMove(Shift: TShiftState; X, Y: Integer); var rX,rY,a,rXo,rYo: extended; s: string; begin if Ruling then begin DrawRuler(RulerX,RulerY); RulerY:=Y; {move or rotate ruler} if (ssAlt in Shift) then RulerFi:=(RulerX-X)/Height*Pi else RulerX:=X; DrawRuler(RulerX,RulerY); a:=sin(RulerFi)/cos(RulerFi)*(YAxis.Max-YAxis.Min)/YAxisLen/ (XAxis.Max-XAxis.Min)*XAxisLen; if IntToRealCoords(X,Y,rX,rY) then S:=Format('%7.4g*X+%-7.4g',[a,rY-rX*a]) else S:=''; if Pos('+-',S)<>0 then System.Delete(S, Pos('+-',S),1); {delete extra "+"} ShowPlotHint(S); inherited MouseMove(Shift, X, Y); Exit; {!!!!!!!!!!} end; if IntToRealCoords(X,Y,rX,rY) then begin if Editing then DrawEdit(X,Y); if Zooming then begin Canvas.Brush.Color:=Color; {1) not Pen, but Brush?! 2) inverts plot bkg} Canvas.DrawFocusRect(CorRect(ZoomXo,ZoomYo,ZoomX,ZoomY)); {erase old} Canvas.DrawFocusRect(CorRect(ZoomXo,ZoomYo,X,Y)); {draw new} ZoomX:=X; ZoomY:=Y; {remember for next cycle} end; if (MouseMode=pmTranslate) and SelectionVisible then begin IntToRealCoords(ZoomX,ZoomY,rXo,rYo); {real coordinates of previous pos} if Translating<>ptmNo then {if translating, update selection} begin DrawSelection; {hide previous selection} if Translating=ptmMove then ShowPlotHint('dX : '+ FloatToStrF(FSelectionLeft-TransX1,XAxis.FFType,XAxis.FWidth, XAxis.FDecimals)+' dY : '+FloatToStrF(FSelectionBottom-TransY1, YAxis.FFType,YAxis.FWidth,YAxis.FDecimals)) else ShowPlotHint('dX : '+ FloatToStrF(Abs((FSelectionRight-FSelectionLeft)/(TransX2-TransX1)), ffFixed,7,4)+' dY : '+FloatToStrF(Abs((FSelectionTop-FSelectionBottom) /(TransY2-TransY1)),ffFixed,7,4)); case Translating of ptmMove: begin FSelectionTop:=FSelectionTop+(rY-rYo); FSelectionBottom:=FSelectionBottom+(rY-rYo); FSelectionLeft:=FSelectionLeft+(rX-rXo); FSelectionRight:=FSelectionRight+(rX-rXo); end; ptmT: FSelectionTop:=FSelectionTop+(rY-rYo); ptmB: FSelectionBottom:=FSelectionBottom+(rY-rYo); ptmL: FSelectionLeft:=FSelectionLeft+(rX-rXo); ptmR: FSelectionRight:=FSelectionRight+(rX-rXo); ptmTL: begin FSelectionTop:=FSelectionTop+(rY-rYo); FSelectionLeft:=FSelectionLeft+(rX-rXo); end; ptmTR: begin FSelectionTop:=FSelectionTop+(rY-rYo); FSelectionRight:=FSelectionRight+(rX-rXo); end; ptmBL: begin FSelectionBottom:=FSelectionBottom+(rY-rYo); FSelectionLeft:=FSelectionLeft+(rX-rXo); end; ptmBR: begin FSelectionBottom:=FSelectionBottom+(rY-rYo); FSelectionRight:=FSelectionRight+(rX-rXo); end; end;{case} DrawSelection; {show selection at new position} ZoomX:=X; ZoomY:=Y; {remember position to use in next MouseMove()} end; with Screen do {change cursor shape in translation mode} if BelongMarker(SelectionLeft,SelectionTop,X,Y) then Cursor:=crSizeNWSE else if BelongMarker(SelectionRight,SelectionTop,X,Y) then Cursor:=crSizeNESW else if BelongMarker((SelectionLeft+SelectionRight)/2,SelectionTop,X,Y) or BelongMarker((SelectionLeft+SelectionRight)/2,SelectionBottom,X,Y) then Cursor:=crSizeNS else if BelongMarker(SelectionLeft,SelectionBottom,X,Y) then Cursor:=crSizeNESW else if BelongMarker(SelectionRight,SelectionBottom,X,Y) then Cursor:=crSizeNWSE else if BelongMarker(SelectionLeft,(SelectionTop+SelectionBottom)/2,X,Y) or BelongMarker(SelectionRight,(SelectionTop+SelectionBottom)/2,X,Y) then Cursor:=crSizeWE else if (rX>SelectionLeft) and (rX<SelectionRight) and (rY<SelectionTop) and (rY>SelectionBottom) then Cursor:=crSize else Cursor:=crDefault; end else ShowPlotHint('X : '+FloatToStrF(rX, XAxis.FFType, XAxis.FWidth, XAxis.FDecimals)+' Y : '+FloatToStrF(rY, YAxis.FFType, YAxis.FWidth, YAxis.FDecimals)); {display real coordinates} end else ShowPlotHint(' '); inherited MouseMove(Shift, X, Y); end; function Translate(x,x1,x2,x1o,x2o: extended): extended; begin if x=x2o then Result:=x2 else Result:=(x1+(x-x1o)/(x2o-x)*x2)/(1+(x-x1o)/(x2o-x)); end; procedure TPlot.MouseUp(Btn: TMouseButton; Shift: TShiftState; X,Y: Integer); var a,rx,ry,rx1,ry1: extended; R: TRect; I: integer; M: boolean; begin if Zooming then begin Zooming:=false; if (ZoomXo=X) or (ZoomYo=Y) or (not IntToRealCoords(X,Y,rx,ry)) then Exit; R:=Correct(ZoomXo,ZoomYo,X,Y); {sort} IntToRealCoords(R.Left,R.Top,rx,ry); IntToRealCoords(R.Right,R.Bottom,rx1,ry1); if MouseMode=pmSelect then begin SelectionTop:=ry; SelectionBottom:=ry1; {update selection} SelectionLeft:=rx; SelectionRight:=rx1; if Assigned(FOnSelectionChange) then FOnSelectionChange(Self); inherited MouseUp(Btn, Shift, X, Y); Exit; {don't zoom!} end; XAxis.AutoScale:=false; YAxis.AutoScale:=false; {reset autoscale} OldX1:=XAxis.Min; OldX2:=XAxis.Max; OldY1:=YAxis.Min; OldY2:=YAxis.Max; FCanUnZoom:=true; {save coordinates in buffer and enable undo} if ((ssAlt in Shift) and (MouseMode=pmAutoZoom)) or (MouseMode=pmUnZoom) then begin {UnZoom} XAxis.Min:=XAxis.Min-(XAxis.Max-XAxis.Min)*(rx-XAxis.Min)/(rx1-rx); XAxis.Max:=XAxis.Max+(XAxis.Max-XAxis.Min)*(XAxis.Max-rx1)/(rx1-rx); YAxis.Min:=YAxis.Min-(YAxis.Max-YAxis.Min)*(ry1-YAxis.Min)/(ry-ry1); YAxis.Max:=YAxis.Max+(YAxis.Max-YAxis.Min)*(YAxis.Max-ry)/(ry-ry1); end else {Zoom} begin XAxis.Min:=rx; XAxis.Max:=rx1; YAxis.Min:=ry1; YAxis.Max:=ry; end; end; if Ruling then begin Ruling:=false; DrawRuler(RulerX,RulerY); end; {hide ruler} if Editing then begin {ok: valid final poin coordinates} Editing:=false; Invalidate;{erase lost "rubber thread" OR old moved point} if IntToRealCoords(X,Y,rx,ry) then {CHECK!!!} with Series[EditSer] do begin SetDataPoint(Container.Items[EditPnt], XColumn, YColumn, rx, ry); Container.Modified:=true; end; end; if Translating<>ptmNo then begin Translating:=ptmNo; if FSelectionLeft>FSelectionRight then begin a:=FSelectionLeft; FSelectionLeft:=FSelectionRight; FSelectionRight:=a; end; if FSelectionBottom>FSelectionTop then begin a:=FSelectionBottom; FSelectionBottom:=FSelectionTop; FSelectionTop:=a; end; if Assigned(FOnSelectionChange) then FOnSelectionChange(Self); M:=false; with ThisSerie do if not Empty then try Screen.Cursor:=crHourGlass; ShowPlotHint(strMoving); for I:=FirstLine to LastLine do begin if LastLine<>FirstLine then Container.ShowProgress( Round((I-FirstLine)/(LastLine-FirstLine)*100)); GetDataPoint(Container.Items[I], XColumn, YColumn, XExpression, YExpression, rX, rY); if (TransX1<=rX) and (TransX2>=rX) and (TransY1<=rY) and (TransY2>=rY) then begin M:=true; rX:=Translate(rX,FSelectionLeft,FSelectionRight,TransX1,TransX2); rY:=Translate(rY,FSelectionBottom,FSelectionTop,TransY1,TransY2); SetDataPoint(Container.Items[I], XColumn, YColumn, rx, ry); end; end;{cycle} if M then begin Invalidate;{!} Container.Modified:=true; end; finally Screen.Cursor:=crDefault; ShowPlotHint(' '); end; end; inherited MouseUp(Btn, Shift, X, Y); end; procedure TPlot.SetDataPoint(D: TData; CX, CY: integer; X, Y: extended); begin if D is TFunction then begin if CX=1 then (D as TFunction).X:=X else (D as TFunction).Y:=X; if CY=1 then (D as TFunction).X:=Y else (D as TFunction).Y:=Y; end; if D is TRealData then begin (D as TRealData).RData[CX]:=X; (D as TRealData).RData[CY]:=Y; end; end; procedure TPlot.PaintPoint(X, Y: integer; T: TPointType; S: integer; C: TCanvas); var psize: integer; {this method is useful to paint legends,dialog boxes,etc} begin if Printing then S:=round(S*FCanvas.Font.PixelsPerInch/PPI); {CORRECT!!!} psize:=S div 2; {calculate halfsize} if psize<1 then with C do Pixels[X,Y]:=Brush.Color else {one pixel!} case T of ptCircle: C.Ellipse(X-psize, Y-psize, X+psize, Y+psize); ptSquare: C.Rectangle(X-psize, Y-psize, X+psize, Y+psize); ptCross : begin C.MoveTo(X,Y-psize); C.LineTo(X,Y+psize); {vert} C.MoveTo(X-psize,Y); C.LineTo(X+psize,Y); {horz} end; ptXCross: begin C.MoveTo(X-psize,Y-psize); C.LineTo(X+psize,Y+psize); {\} C.MoveTo(X-psize,Y+psize); C.LineTo(X+psize,Y-psize); {/} end; ptAsterisk: begin C.MoveTo(X,Y-psize); C.LineTo(X,Y+psize); {|} C.MoveTo(X-psize,Y); C.LineTo(X+psize,Y); {-} C.MoveTo(X-psize,Y-psize); C.LineTo(X+psize,Y+psize); {\} C.MoveTo(X-psize,Y+psize); C.LineTo(X+psize,Y-psize); {/} end; end;{case} end; procedure TPlot.DrawRuler(X, Y: integer); const WFactor=40; LFactor=3; {size of ruler relatively to plot} var A: array[0..4] of TPoint; Fi,Len: extended; begin if RulerFi>Pi/2.1 then RulerFi:=Pi/2.1; {correct rotation angle} if RulerFi<-Pi/2.1 then RulerFi:=-Pi/2.1; Fi:=arctan(Height/WFactor/Width*LFactor); Len:=sqrt(sqr(Width/LFactor)+sqr(Height/WFactor)); A[0]:=Point(Round(X-Len*cos(RulerFi+Fi)), Round(Y+Len*sin(RulerFi+Fi))); A[1]:=Point(Round(X-Len*cos(RulerFi-Fi)), Round(Y+Len*sin(RulerFi-Fi))); A[2]:=Point(Round(X+Len*cos(RulerFi+Fi)), Round(Y-Len*sin(RulerFi+Fi))); A[3]:=Point(Round(X+Len*cos(RulerFi-Fi)), Round(Y-Len*sin(RulerFi-Fi))); A[4]:=A[0]; Canvas.Pen.Mode:=pmXor; Canvas.Pen.Width:=1; {set pen attributes} Canvas.Pen.Color:=Color; Canvas.Pen.Style:=psSolid; Canvas.PolyLine(A); Canvas.Pen.Mode:=pmNotXor; Canvas.MoveTo(X-Round(Len*cos(RulerFi)), Y+Round(Len*sin(RulerFi))); Canvas.LineTo(X+Round(Len*cos(RulerFi)), Y-Round(Len*sin(RulerFi))); Canvas.Pen.Mode:=pmCopy; {restore pen mode!} end; procedure TPlot.Print(W, H: integer); begin FCanvas:=Printer.Canvas; FWidth:=W; FHeight:=H; Printing:=true; try Paint; finally Printing:=false; FCanvas:=Canvas; FWidth:=Width; FHeight:=Height; Refresh; end; end; function TPlot.RealToIntCoords(X,Y: extended; var iX,iY: integer): boolean; {^ returns true if coordinates are out of range} function Belong(A,B,X: TReal): boolean; {returns true if A<X<B} var T: TReal; begin if B<A then begin T:=A; A:=B; B:=T; end; if (A<=X) and (X<=B) then Belong:=true else Belong:=false; end; begin if Belong(XAxis.Min, XAxis.Max, X) and Belong(YAxis.Min, YAxis.Max, Y) then begin Result:=false; with XAxis do if Min=Max then iX:=YAxisGap+(XAxisLen div 2) else iX:=YAxisGap+Round((X-Min)/(Max-Min)*XAxisLen); with YAxis do if Min=Max then iY:=FHeight-XAxisGap-(YAxisLen div 2) else iY:=FHeight-XAxisGap-Round((Y-Min)/(Max-Min)*YAxisLen); end else Result:=true; {real coordinates are out of range!} end; procedure TPlot.SetBorderStyle(B: TBorderStyle); begin if FBorderStyle<>B then begin FBorderStyle:=B; Changed(Self); end; end; procedure TPlot.SetSerieIndex(const Value: integer); begin if (Value>-2) and (Value<Series.Count) then FSerieIndex:=Value; end; function TPlot.GetThisSerie: TSerie; begin if (SerieIndex>=0) and (SerieIndex<Series.Count) then Result:=Series[SerieIndex] else Result:=nil; end; procedure TPlot.SetSeries(const Value: TSeries); begin FSeries.Assign(Value); end; procedure TPlot.SetTransparent(B: boolean); begin if FTransparent<>B then begin FTransparent:=B; Changed(Self); end; end; procedure TPlot.SetXAxis(Value: TAxis); begin FXAxis.Assign(Value); end; procedure TPlot.SetYAxis(Value: TAxis); begin FYAxis.Assign(Value); end; procedure TPlot.ShowPlotHint(H: string); begin if Assigned(FOnHint) then FOnHint(Self, H); end; procedure TPlot.ShowPlotError(H: string); begin if Assigned(FOnError) then FOnError(Self, H); end; procedure TPlot.UndoZoom; begin if FCanUnZoom then begin FCanUnZoom:=false; XAxis.Min:=OldX1; XAxis.Max:=OldX2; YAxis.Min:=OldY1; YAxis.Max:=OldY2; end; end; function TPlot.GetSelection(const Index: integer): extended; begin case Index of 1: Result:=FSelectionTop; 2: Result:=FSelectionBottom; 3: Result:=FSelectionLeft; 4: Result:=FSelectionRight; end; end; procedure TPlot.SetSelection(const Index: Integer; const Value: extended); begin case Index of 1: if Value<>FSelectionTop then begin FSelectionTop:=Value; Changed(Self); end; 2: if Value<>FSelectionBottom then begin FSelectionBottom:=Value; Changed(Self); end; 3: if Value<>FSelectionLeft then begin FSelectionLeft:=Value; Changed(Self); end; 4: if Value<>FSelectionRight then begin FSelectionRight:=Value; Changed(Self); end; end; end; procedure TPlot.SetSelectionVisible(const Value: boolean); begin if FSelectionVisible<>Value then begin FSelectionVisible:=Value; Changed(Self); end; end; procedure TPlot.SetMouseMode(M: TPlotMouseMode); begin if ((M=pmTranslate) or (FMouseMode=pmTranslate)) and (FMouseMode<>M) and SelectionVisible then begin DrawSelection; FMouseMode:=M; DrawSelection; end else FMouseMode:=M; end; procedure TPlot.DrawSelection; {draw selection frame} var Buf: array of TPoint; I,J: integer; rX,rY: extended; begin with FCanvas.Pen do begin Color:=clBlack; Width:=1; Mode:=pmNotXor; Style:=psDot; end; with FCanvas.Brush do begin Color:=clWhite; Style:=bsSolid; end; DrawLine(SelectionLeft,SelectionTop,SelectionRight,SelectionTop); DrawLine(SelectionLeft,SelectionBottom,SelectionRight,SelectionBottom); DrawLine(SelectionLeft,SelectionTop,SelectionLeft,SelectionBottom); DrawLine(SelectionRight,SelectionTop,SelectionRight,SelectionBottom); if MouseMode=pmTranslate then {and markers in translate mode} begin FCanvas.Pen.Style:=psSolid; FCanvas.Pen.Width:={1}2{slow!!!}; FCanvas.Brush.Color:=clBlack; DrawPoint(SelectionLeft,SelectionTop,ptSquare,MSZ); DrawPoint(SelectionRight,SelectionTop,ptSquare,MSZ); DrawPoint((SelectionLeft+SelectionRight)/2,SelectionTop,ptSquare,MSZ); DrawPoint(SelectionLeft,SelectionBottom,ptSquare,MSZ); DrawPoint(SelectionRight,SelectionBottom,ptSquare,MSZ); DrawPoint((SelectionLeft+SelectionRight)/2,SelectionBottom,ptSquare,MSZ); DrawPoint(SelectionLeft,(SelectionTop+SelectionBottom)/2,ptSquare,MSZ); DrawPoint(SelectionRight,(SelectionTop+SelectionBottom)/2,ptSquare,MSZ); if (Translating<>ptmNo) and (TransPointCount>0) then begin {draw translation preview} SetLength(Buf,TransPointCount); J:=0; for I:=0 to TransPointCount-1 do begin rX:=Translate(TransBuf[I].X,FSelectionLeft, FSelectionRight,TransX1,TransX2); rY:=Translate(TransBuf[I].Y,FSelectionBottom, FSelectionTop,TransY1,TransY2); if not RealToIntCoords(rX,rY,Buf[J].X,Buf[J].Y) then Inc(J); end; if J>0 then begin SetLength(Buf,J); FCanvas.PolyLine(Buf); end; end; end; end; {----------------------------------------------------------------} {--- next method is the heart of TPlot - it does all stuff!!! ---} {----------------------------------------------------------------} procedure TPlot.Paint; type TPointCache=array [1..MaxInt div SizeOf(TPoint)-1] of TPoint; var S: string[250]; I,J,tmp,tmp2: integer; {general service} X,Xo,Y,Yo: extended; First: boolean; {for draw series} bfXY,bfY,bfX,bfX2: extended; {for bestfit line} PointCache: ^TPointCache; PointCacheSize: integer; fX1,fX2: extended; {for functional series limits} begin Screen.Cursor:=crHourGlass; if not Printing then begin FWidth:=Width; FHeight:=Height; end; {SCALE series:} ShowPlotHint(msgScaling); if XAxis.AutoScale or YAxis.AutoScale then for I:=0 to Series.Count-1 do {calculate SERIE SCALES (if possible!)} begin with Series[I] do {I-serie counter} begin Scaled:=false; tmp:=0; {point counter for BF} bfXY:=0; bfX:=0; bfY:=0; bfX2:=0; {clear best fit sums accumulators} if Empty then Continue; {empty serie; goto next} for J:=FirstLine to LastLine do begin if ((J mod Interleave)<>0) and (LastLine<>J) then Continue; try FN:=J-FirstLine; FNA:=J; {initialize expression pseudoparameters} if GetDataPoint(Container.Items[J], XColumn, YColumn, XExpression, YExpression, X, Y) then Continue; bfX:=bfX+X; bfY:=bfY+Y; bfXY:=bfXY+(X*Y); bfX2:=bfX2+(X*X); {BF..} Inc(tmp); if Scaled then begin if X<X1 then X1:=X; if X>X2 then X2:=X; {X,Y1-min; X,Y2-max} if Y<Y1 then Y1:=Y; if Y>Y2 then Y2:=Y; end else begin Scaled:=true; X1:=X; Y1:=Y; X2:=X; Y2:=Y; end; except {no data in list or trealdata!} on EListError do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieBlock,[I])); Break; end; on ERealDataError do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieCols,[I,J])); Break; end; on E:EMathParser do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieExpr,[I,E.Message])); Break; end; end;{try} end;{for J} if Scaled and (tmp>0) then {calculate best fit coefficients} begin bfA:=tmp*bfX2-bfX*bfX; if bfA<>0 then begin bfA:=(tmp*bfXY-bfX*bfY)/bfA; bfB:=(bfY-bfA*bfX)/tmp; end else FShowBestFit:=false; {unable!} end else FShowBestFit:=false; end;{with} end;{scale series} First:=true; {now calculate Min-Max BY SERIES!} for I:=0 to Series.Count-1 do with Series[I] do begin if not (XAxis.AutoScale or YAxis.AutoScale) then Scaled:=false; {clear!!!} if not Scaled then Continue; if First then begin First:=false; Xo:=X1; X:=X2; Yo:=Y1; Y:=Y2; end else begin if X1<Xo then Xo:=X1; if X2>X then X:=X2; {X,Yo-min, X,Y-max} if Y1<Yo then Yo:=Y1; if Y2>Y then Y:=Y2; end; end; if not First then {set axes scale (w/o side effect)} begin if YAxis.AutoScale then with YAxis do begin FMin:=Yo-(Y-Yo)*FMargins; FMax:=Y+(Y-Yo)*FMargins; end; if XAxis.AutoScale then with XAxis do begin FMin:=Xo-(X-Xo)*FMargins; FMax:=X+(X-Xo)*FMargins; end; fX1:=Xo; fX2:=X; {remember scale for functional series} end else begin fX1:=XAxis.Min; fX2:=XAxis.Max; end; {START PAINT:} ShowPlotHint(msgPlotting); {} with FCanvas.Pen do {Set pen attributes (frame MUST be always black)} begin Color:=clBlack; Width:=1; Mode:=pmCopy; Style:=psSolid; end; if Transparent or Printing then FCanvas.Brush.Style:=bsClear {transparent?} else with FCanvas do begin Brush.Style:=bsSolid; Brush.Color:=Color; end; if BorderStyle=bsSingle then FCanvas.Rectangle(0,0,FWidth,FHeight) {frame} else FCanvas.FillRect(Rect(0,0,FWidth,FHeight)); {} FCanvas.Brush.Style:=bsClear; {update brush style (for textouts!)} {Calculate gaps, labels & axes sizes:} FCanvas.Font:=XAxis.Font;{X} S:='.'; for I:=1 to XAxis.Format.Width do S:=S+'E'; {simulate label} if XAxis.Format.FType=ffExponent then {correct} begin S:=S+'+E0'; if XAxis.Format.Decimals=3 then S:=S+'00'; end; XLabelW:=FCanvas.TextWidth(S); XLabelH:=FCanvas.TextHeight(S); FCanvas.Font:=YAxis.Font;{Y} S:='.'; for I:=1 to YAxis.Format.Width do S:=S+'E'; if YAxis.Format.FType=ffExponent then begin S:=S+'+E0'; if YAxis.Format.Decimals=3 then S:=S+'00'; end; YLabelW:=FCanvas.TextWidth(S); YLabelH:=FCanvas.TextHeight(S); {derive:} if XAxis.Title='' then XAxisGap:=XLabelH+YLabelH else XAxisGap:=2*XLabelH+YLabelH; YAxisGap:=YLabelW+2*YlabelH; XAxisLen:=FWidth-YAxisGap-(Round(XLabelW/2)+XLabelH); if YAxis.Title='' then YAxisLen:=FHeight-XAxisGap-(YLabelH div 2) else YAxisLen:=FHeight-XAxisGap-YLabelH; XTickLen:=YLabelH; YTickLen:=XLabelH; {Draw Y-Axis:} FCanvas.Font:=YAxis.Font; FCanvas.Pen:=YAxis.Pen; if Printing then FCanvas.Pen.Width:= {when printing - in points!!!} round(FCanvas.Pen.Width*FCanvas.Font.PixelsPerInch/PPI); with FCanvas do begin MoveTo(YAxisGap, FHeight-XAxisGap); {main axis} LineTo(YAxisGap, FHeight-XAxisGap-YAxisLen); if YAxis.ShowGrid then {duplicate at the right of X-axis} begin MoveTo(YAxisGap+XAxisLen, FHeight-XAxisGap); LineTo(YAxisGap+XAxisLen, FHeight-XAxisGap-YAxisLen); end; for I:=0 to YAxis.MajorTicks do {Note! paint N+1 dashes!} begin tmp:=FHeight-XAxisGap-Round(YAxisLen/(YAxis.MajorTicks)*I);{Y of majtik} MoveTo(YAxisGap, tmp); LineTo(YAxisGap-YTickLen, tmp); {major tick} if YAxis.ShowGrid then Lineto(YAxisGap+XAxisLen, tmp); {grid line} with YAxis do S:=FloatToStrF(Min+(Max-Min)/MajorTicks*I, Format.FType, Format.Width, Format.Decimals); TextOut(YAxisGap-YTickLen-TextWidth(S)-2,tmp-(YlabelH div 2), S); if I<YAxis.MajorTicks then for J:=1 to YAxis.MinorTicks-1 do {NOTE! n-1!!!} begin {minor ticks} tmp2:=tmp-Round(YAxisLen/(YAxis.MajorTicks*YAxis.MinorTicks)*J); MoveTo(YAxisGap, tmp2); LineTo(YAxisGap-(YTickLen div 2), tmp2); end; end; S:=YAxis.Title; if YAxis.Expression<>'' then S:=S+' <'+YAxis.Expression+'>'; if YAxis.Title<>'' then TextOut(YAxisGap,0,S); end; {Draw X-Axis:} FCanvas.Font:=XAxis.Font; FCanvas.Pen:=XAxis.Pen; if Printing then FCanvas.Pen.Width:= {when printing - in points!!!} round(FCanvas.Pen.Width*FCanvas.Font.PixelsPerInch/PPI); with FCanvas do begin MoveTo(YAxisGap, FHeight-XAxisGap); {main axis} LineTo(YAxisGap+XAxisLen, FHeight-XAxisGap); if XAxis.ShowGrid then {duplicate at the top of Y-axis} begin MoveTo(YAxisGap, FHeight-XAxisGap-YAxisLen); LineTo(YAxisGap+XAxisLen, FHeight-XAxisGap-YAxisLen); end; for I:=0 to XAxis.MajorTicks do begin tmp:=YAxisGap+Round(XAxisLen/(XAxis.MajorTicks)*I); {X of major tick} MoveTo(tmp, FHeight-XAxisGap); LineTo(tmp, FHeight-XAxisGap+XTickLen); if XAxis.ShowGrid then LineTo(tmp, FHeight-XAxisGap-YAxisLen); {grid} with XAxis do S:=FloatToStrF(Min+(Max-Min)/MajorTicks*I, Format.FType, Format.Width, Format.Decimals); S:=Trim(S); TextOut(tmp-(TextWidth(S)div 2), FHeight-XAxisGap+XTickLen, S); if I<XAxis.MajorTicks then for J:=1 to XAxis.MinorTicks-1 do begin tmp2:=tmp+Round(XAxisLen/(XAxis.MajorTicks*XAxis.MinorTicks)*J); MoveTo(tmp2, FHeight-XAxisGap); LineTo(tmp2, FHeight-XAxisGap+(XTickLen div 2)); end; end; S:=XAxis.Title; if XAxis.Expression<>'' then S:=S+' <'+XAxis.Expression+'>'; if XAxis.Title<>'' then TextOut((FWidth-TextWidth(S)) div 2, FHeight-XAxisGap+XTickLen+XLabelH, S); end; {Draw series:} for I:=0 to Series.Count-1 do begin with Series[I] do begin if Empty then Continue; {empty serie; goto next} FCanvas.Pen:=Series[I].Pen; FCanvas.Brush:=Series[I].Brush; {set tools} if Printing then FCanvas.Pen.Width:= {when printing - in points!!!} round(FCanvas.Pen.Width*FCanvas.Font.PixelsPerInch/PPI); try tmp:=1; PointCacheSize:=LastLine-FirstLine+1; Scaled:=false; tmp2:=0; {point counter for BF} bfXY:=0; bfX:=0; bfY:=0; bfX2:=0; {clear best fit sums accumulators} GetMem(PointCache,PointCacheSize*SizeOf(TPoint)); {for ALL points!} for J:=FirstLine to LastLine do {fill point cache} begin if ((J mod Interleave)<>0) and (LastLine<>J) then Continue; try FN:=J-FirstLine; FNA:=J; if GetDataPoint(Container.Items[J], XColumn, YColumn, XExpression, YExpression, X, Y) then Continue; bfX:=bfX+X; bfY:=bfY+Y; bfXY:=bfXY+(X*Y); bfX2:=bfX2+(X*X); {BF..} Inc(tmp2); if Scaled then begin if X<X1 then X1:=X; if X>X2 then X2:=X; {X,Y1-min; X,Y2-max} if Y<Y1 then Y1:=Y; if Y>Y2 then Y2:=Y; end else begin Scaled:=true; X1:=X; Y1:=Y; X2:=X; Y2:=Y; end; except {no data in list or trealdata!} on EListError do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieBlock,[I])); Break; end; on ERealDataError do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieCols,[I,J])); Break; end; on E:EMathParser do begin Scaled:=false; ClearBlock; Screen.Cursor:=crDefault; ShowPlotError(Format(errSerieExpr,[I,E.Message])); Break; end; end; if not RealToIntCoords(X,Y,PointCache^[tmp].X,PointCache^[tmp].Y) then inc(tmp); {remember in cache only valid points} end;{for J} finally {now data in cache valid; ready to paint points!} if LineVisible then Polyline(FCanvas.Handle,PointCache^,tmp-1); {line} if PointVisible then for J:=1 to tmp-1 do PaintPoint(PointCache^[J].X,PointCache^[J].Y, PointType,PointSize,FCanvas); {and points} FreeMem(PointCache,PointCacheSize*SizeOf(TPoint)); {deallocate cache} end; if Scaled and (tmp2>0) then {calculate best fit coefficients} begin bfA:=tmp2*bfX2-bfX*bfX; if bfA<>0 then begin bfA:=(tmp2*bfXY-bfX*bfY)/bfA; bfB:=(bfY-bfA*bfX)/tmp2; end else FShowBestFit:=false; {unable!} end else FShowBestFit:=false; if ShowBestFit and Scaled and (bfA<>0) then {draw best fit line} begin if X1<XAxis.Min then X1:=XAxis.Min; // correct fbf line rectangle if X2>XAxis.Max then X2:=XAxis.Max; if Y1<YAxis.Min then Y1:=YAxis.Min; if Y2>YAxis.Max then Y2:=YAxis.Max; Xo:=X1; Yo:=bfA*X1+bfB; if Yo<Y1 then begin Yo:=Y1; Xo:=(Y1-bfB)/bfA; end; if Yo>Y2 then begin Yo:=Y2; Xo:=(Y2-bfB)/bfA; end; X:=X2; Y:=bfA*X2+bfB; if Y<Y1 then begin Y:=Y1; X:=(Y1-bfB)/bfA; end; if Y>Y2 then begin Y:=Y2; X:=(Y2-bfB)/bfA; end; DrawLine(Xo,Yo,X,Y); end; end;{with} end;{for} {Draw functional series: this cycle slightly differs from above!} for I:=0 to Series.Count-1 do begin with Series[I] do if IsFunction and (LastLine>FirstLine){!!!} and (YExpression<>'') then begin FCanvas.Pen:=Series[I].Pen; FCanvas.Brush:=Series[I].Brush; if Printing then FCanvas.Pen.Width:= round(FCanvas.Pen.Width*FCanvas.Font.PixelsPerInch/PPI); PointCacheSize:=LastLine-FirstLine+1; tmp:=1; GetMem(PointCache,PointCacheSize*SizeOf(TPoint)); try for J:=FirstLine to LastLine do try FX:=fX1+(fX2-fX1)/(LastLine-FirstLine)*(J-FirstLine); FY:=FParser.Parse(YExpression); {note: use ONLY YAxis expression!} if YAxis.Expression<>'' then FY:=FParser.Parse(YAxis.Expression); if not RealToIntCoords(FX,FY,PointCache^[tmp].X,PointCache^[tmp].Y) then inc(tmp); {as for "normal" serie (see above)} except on E:EMathParser do begin Screen.Cursor:=crDefault; YExpression:=''; ShowPlotError(Format(errSerieExpr,[I,E.Message])); Break; end; end; if LineVisible then Polyline(FCanvas.Handle,PointCache^,tmp-1); if PointVisible then for J:=1 to tmp-1 do PaintPoint(PointCache^[J].X,PointCache^[J].Y, PointType,PointSize,FCanvas); finally FreeMem(PointCache,PointCacheSize*SizeOf(TPoint)); end; end;{with if} end;{for} FCanvas.Font:=Font; FCanvas.Pen:=Pen; FCanvas.Brush:=Brush; if Assigned(OnPaint) then OnPaint(Self); {allow additional painting} if SelectionVisible then DrawSelection; {draw selection frame after all} ShowPlotHint(' '); Screen.Cursor:=crDefault; end; {-------------------------------------------------------------} {component registration - this unit may be used separately from dm2000} procedure Register; begin RegisterComponents('DM2000', [TPlot]); end; end.