yo_daz_uk
asked on
Delphi 5 upgrade components for BDS2006
Hi,
Background info .....
Before a week ago i had never even seen a delphi file let alone used one, so I do not really understand it very well so please bear with me.
We have a program that uses a PCI hardware card that measures speed (as well as some machinery to test speed). In 2000 a company wrote the software in Delphi 5 to capture the speed data. Now the computer is getting old so we would like to upgrade it to a newer computer. Now the company that did the software no longer employees a Delphi programmer so itt has come to me to have a look at.
We would like to get the delphi 5 code working in BDS2006, but i have hit a few snags. It is with components and packages and me not understanding them or getting them to work. Errors come up saying that it cannot find things on the code, so i think i need to add the components in.
In delphi 5 there are some components (i think) that have been written and can be used. If i go to project options click on the packages tab and select Borland User Components -> then there are 4 components. Also, if i select Component -> configure pallet there is a page called Servocon and the components are in there as well.
These components contain classes which are what delphi says has the errors when using BDS2006.
I have the source files for these, with the file extensions .dcu and .pas and some have a .dcr and .dfm for each of the errors, and i would like to know how to get these (i think there components looking at delphi 5) into BDS2006.
Please could anyone give me a step by step guide how to get these into BDS2006 so i can get rid of these errors.
Thanks,
Daz
Background info .....
Before a week ago i had never even seen a delphi file let alone used one, so I do not really understand it very well so please bear with me.
We have a program that uses a PCI hardware card that measures speed (as well as some machinery to test speed). In 2000 a company wrote the software in Delphi 5 to capture the speed data. Now the computer is getting old so we would like to upgrade it to a newer computer. Now the company that did the software no longer employees a Delphi programmer so itt has come to me to have a look at.
We would like to get the delphi 5 code working in BDS2006, but i have hit a few snags. It is with components and packages and me not understanding them or getting them to work. Errors come up saying that it cannot find things on the code, so i think i need to add the components in.
In delphi 5 there are some components (i think) that have been written and can be used. If i go to project options click on the packages tab and select Borland User Components -> then there are 4 components. Also, if i select Component -> configure pallet there is a page called Servocon and the components are in there as well.
These components contain classes which are what delphi says has the errors when using BDS2006.
I have the source files for these, with the file extensions .dcu and .pas and some have a .dcr and .dfm for each of the errors, and i would like to know how to get these (i think there components looking at delphi 5) into BDS2006.
Please could anyone give me a step by step guide how to get these into BDS2006 so i can get rid of these errors.
Thanks,
Daz
ASKER
Thanks for your reply ...
When i try and open up the form DunTyreAbsorb.pas i get an error saying
Class TRtChart not found. Ig nore the error and continue?
The trtChart is in a file called Rtchart.pas
unit RtChart;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ChartExt,
ExtCtrls, Printers, Menus, Clipbrd, StdCtrls, Math, ComCtrls;
{*************************
const crMarkerCursor = 25; { custom cursor value }
const xlWBATWorksheet = $FFFFEFB9; { constant needed for excel export }
const ChartMarker = 5;
const CntrMarker = 6;
const NextMarker = 8;
const PrevMarker = 9;
{*************************
type
TRePlot = class;
TRtChart = class(TCustomPanel)
private
FPlot : TBitmap;
FXAxis : TAxis;
FYAxis : TAxis;
FY2Axis : TAxis;
FTitle : TTitle;
FOld : TAxisLimit;
FMarker : TMarker;
FData : array of TDataSeries;
FItems : Integer; { number of series in a chart }
FPlotArea : TRect;
FCoord : TCoord;
FCoordFont : TFont;
FZooming : Boolean;
FOrigin : TPoint;
FMovePt : TPoint;
FHairLineMovePt: TPoint;
FSetHairLine : Boolean;
FTickLength : Integer;
FBoxColor : TColor;
FBoxStyle : TBoxStyle;
FGridStyle : TPenStyle;
FGridColor : TColor;
FHairLines : Boolean;
FRtChartPopUp : TPopUpMenu;
FPopUpItems : array[0..11] of TMenuItem;
FImageList : TImageList;
FXFactor : Single;
FYFactor : Single;
FXOffset : Single;
FYOffset : Single;
FPlotting : Boolean;
function ShiftUp(ASeriesCntr: Integer): integer;
procedure PlotPoint(AWhichSeries: Integer);
procedure ReDrawPlot(ACanvas: TCanvas; AHeight: Integer);
procedure DrawTicks(ACanvas: TCanvas);
procedure DrawTitles(ACanvas: TCanvas);
procedure SetupGrid;
procedure ZoomIn(AStartPoint, AEndPoint :TPoint);
procedure MoveMarker(AShift: TShiftState; AX, AY: Integer);
procedure ShowMarkerCoord(AX, AY: Single; AWhichMarker: Boolean);
procedure DrawMarker(DrawNew: Boolean; X, Y: Single; WhichMarker: Boolean);
procedure PrintClick(Sender: TObject);
procedure ResetZoomClick(Sender: TObject);
procedure ShowMarkersClick(Sender: TObject);
procedure CenterMarkersClick(Sender:
procedure CopyClipBoardClick(Sender:
procedure NextPlotClick(Sender: TObject);
procedure PrevPlotClick(Sender: TObject);
procedure AxisChanged(Sender: TObject);
procedure MoveValiDateXY(ADrawX, ADrawY:Single; var AMoveX, AMoveY: Single);
procedure DrawValiDateXY(AMoveX, AMoveY: Single; var ADrawX, ADrawY: Single);
procedure GotRePlot(Sender: TObject);
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure SetTickLength(ATickLength:
procedure SetBoxColor(ABoxColor: TColor);
procedure SetBoxStyle(ABoxStyle: TBoxStyle);
procedure SetGridStyle(AGridStyle: TPenStyle);
procedure SetGridColor(AGridColor: TColor);
procedure SetCoordFont(ACoordFont: TFont);
procedure SetupPopUp;
function GetData(Index: Integer): TDataSeries;
procedure SetData(Index: Integer; Value: TDataSeries);
procedure ReSizePlot(Sender: TObject);
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
Procedure AddSeries(SeriesName: String; PlotColor: TColor;PlotStyle: TPlotStyle);
procedure SetLimits(XMin, XMax, YMin, YMax, XScale, YScale: Single; Num: Integer);
function ReMoveSeries(WhichSeries: Integer): Boolean; overload;
function ReMoveSeries(SeriesName: String): Boolean; overload;
procedure ReMoveAll;
procedure UpDatePlot;
procedure ClearAll;
procedure Add(X, Y: Single; SeriesNumber: Integer);
procedure Print;
procedure ResetPlot;
procedure LinGradFit;
procedure RemoveLinGradFit;
procedure PlotSave(FileName: String);
procedure PlotOpen(FileName: String);
procedure SetDefaults(FileName: String);
procedure GetDefaults(FileName: String);
procedure PlotCsvExport(FileName: String);
procedure PlotExcelExport;
procedure AutoScaleClick(Sender: TObject);
property Items[Index: Integer]: TDataSeries read GetData write SetData;
property Plotting: Boolean read FPlotting write FPlotting;
property Count: Integer read FItems write FItems;
published
property Align;
property Color;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property BorderStyle;
property TickLength: Integer read FTickLength write SetTickLength;
property BoxColor: TColor read FBoxColor write SetBoxColor default clWhite;
property BoxStyle: TBoxStyle read FBoxStyle write SetBoxStyle default bsAll;
property GridStyle: TPenStyle read FGridStyle write SetGridStyle default psDash;
property GridColor: TColor read FGridColor write SetGridColor default clGray;
property HairLines: Boolean read FHairLines write FHairLines;
property Coords: TFont read FCoordFont write SetCoordFont;
property XAxis: TAxis read FXAxis write FXAxis;
property YAxis: TAxis read FYAxis write FYAxis;
property Y2Axis: TAxis read FY2Axis write FY2Axis;
property Title: TTitle read FTitle write FTitle;
end;
{*************************
TRePlot = class(TThread)
private
FIdx : Integer;
FMoveX : Single;
FMoveY : Single;
FDrawX : Single;
FDrawY : Single;
FChart : TRtChart;
public
constructor Create(Chart: TRtChart);
procedure Execute; override;
procedure DoReDraw;
function GetChart: TBitmap;
end;
{*************************
procedure Register;
{-------------------------
implementation
uses ExpPro;
{$R RtChart.RES}
{-------------------------
{ TRePlot **************************
{-------------------------
constructor TRePlot.Create(Chart: TRtChart);
begin
FChart := Chart;
Priority := tpTimeCritical;
FreeOnTerminate := True;
inherited Create(False);
end;
{-------------------------
function TRePlot.GetChart: TBitmap;
begin
Result := FChart.FPlot;
end;
{-------------------------
procedure TRePlot.DoReDraw;
begin
with FChart.FPlot do
begin
Canvas.MoveTo(Round(FMoveX
case FChart.FData[FIdx].PlotSty
psLines : Canvas.LineTo(Round(FDrawX
psPoints: if (FMoveX <> FDrawX) and (FMoveY <> FDrawY) then
Canvas.Ellipse(Round(FDraw
end;
end;
end;
{-------------------------
procedure TRePlot.Execute;
var
I, J: Integer;
begin
Screen.Cursor := crHourGlass;
with FChart do
begin
for I := Low(FData) to High(FData) do { do all of the series }
begin
for J := 0 to FData[I].Count do { do all point in each series }
begin
if (FData[I].Count > 1) and (J > 1) then { see if there's more than point to plot }
begin
with FPlot.Canvas, FData[I] do
begin
Pen.Color := PlotColor;
{ move to where the first/last point was }
FMoveX := (GetX(J - 2) * XScale * FXFactor) + FXOffset;
FMoveY := FPlot.Height - (GetY(J - 2) * YScale * FYFactor) - FYOffset;
{ get the lasest plots points }
FDrawX := (GetX(J - 1) * XScale * FXFactor) + FXOffset;
FDrawY := FPlot.Height - (GetY(J - 1) * YScale * FYFactor ) - FYOffset;
MoveValiDateXY(FDrawX, FDrawY, FMoveX, FMoveY);
DrawValiDateXY(FMoveX, FMoveY, FDrawX, FDrawY);
FIdx := I;
Synchronize(DoReDraw);
end;
end;
end;
end;
end;
Screen.Cursor := 0;
end;
{-------------------------
{ TRtChart **************************
{-------------------------
constructor TRtChart.Create(Owner: TComponent);
begin
inherited Create(Owner);
FXAxis := TAxis.Create;
FYAxis := TAxis.Create;
FY2Axis := TAxis.Create;
FTitle := TTitle.Create;
FMarker := TMarker.Create;
FPlot := TBitmap.Create;
FPlot.Transparent := True;
FPlot.TransparentColor := clWhite;
Width := 250;
Height := 250;
Color := clBlack;
FItems := 0;
FCoordFont := TFont.Create;
FCoordFont.Height := 10;
FCoordFont.Color := clWhite;
OnResize := ReSizePlot;
FXAxis.Max := 10;
FXAxis.Min := -10;
FYAxis.Max := 10;
FYAxis.Min := -10;
FY2Axis.Max := 10;
FY2Axis.Min := -10;
FOld.X.Max := FXAxis.Max;
FOld.X.Min := FXAxis.Min;
FOld.Y.Max := FYAxis.Max;
FOld.Y.Min := FYAxis.Min;
FOld.Y2.Max := FY2Axis.Max;
FOld.Y2.Min := FY2Axis.Min;
FXAxis.Interval := 50;
FYAxis.Interval := 50;
FY2Axis.Interval := 50;
FTickLength := 5;
FHairLines := False;
FGridColor := clWhite;
FBoxColor := clWhite;
FGridStyle := psDot;
FGridColor := clGray;
FPlotting := False;
FCoord := TCoord.Create;
FCoord.Canvas.Font.Assign(
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
FY2Axis.OnChange := AxisChanged;
FTitle.OnChange := AxisChanged;
FTitle.Font.OnChange := AxisChanged;
FXAxis.Font.OnChange := AxisChanged;
FYAxis.Font.OnChange := AxisChanged;
FY2Axis.Font.OnChange := AxisChanged;
SetupPopUp; { create popup menu }
{ load custom cursor }
Screen.Cursors[crMarkerCur
end;
{-------------------------
destructor TRtChart.Destroy;
begin
FXAxis.Free;
FYAxis.Free;
FY2Axis.Free;
FTitle.Free;
FCoord.Free;
FCoordFont.Free;
FPlot.Free;
FRtChartPopUp.Free;
FImageList.Free;
FMarker.Free;
inherited Destroy;
end;
{-------------------------
function TRtChart.GetData(Index: Integer): TDataSeries;
begin
Result := FData[Index];
end;
{-------------------------
procedure TRtChart.SetData(Index: Integer; Value: TDataSeries);
begin
FData[Index] := Value;
end;
{-------------------------
procedure TRtCHart.ReSizePlot(Sender
begin
FMarker.Width := Width;
FMarker.Height := 32;
FMarker.Canvas.Brush.Color
FMarker.Canvas.FillRect(Re
FPlot.Canvas.FillRect(Rect
SetupGrid;
if FPlotting then with TRePlot.Create(Self) do OnTerminate := GotRePlot
else ReDrawPlot(FPlot.Canvas, FPlot.Height);
end;
{-------------------------
procedure TRtChart.GotRePlot(Sender:
begin
Paint;
end;
{-------------------------
procedure TRtChart.Paint;
begin
inherited Paint;
SetupGrid;
DrawTicks(Canvas);
DrawTitles(Canvas);
Canvas.Draw(FPlotArea.Left
if FPopUpItems[ChartMarker].C
begin
ShowMarkerCoord(FData[FMar
ShowMarkerCoord(FData[FMar
Canvas.Draw(0, 0, FMarker);
DrawMarker(True, 0, 0, False);
DrawMarker(True, 0, 0, True);
end;
end;
{-------------------------
procedure TRtChart.SetupGrid;
var
MaxWidth, MinWidth: Integer;
begin
if FTitle.ShowTitle then FPlotArea.Top := 10 + FTitle.Font.Height + 10
else FPlotArea.Top := 10 + FYAxis.Font.Height;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
MaxWidth := Round(Canvas.TextWidth(For
MinWidth := Round(Canvas.TextWidth(For
if FYAxis.Max > FYAxis.Min then FPlotArea.Left := 10 + MaxWidth
else FPlotArea.Left := 10 + MinWidth;
MaxWidth := Round(Canvas.TextWidth(For
MinWidth := Round(Canvas.TextWidth(For
if FY2Axis.Max > FY2Axis.Min then FPlotArea.Right := Width - (10 + MaxWidth)
else FPlotArea.Right := Width - (10 + MinWidth);
if FXAxis.ShowTitle then
FPlotArea.Bottom := Height - (FXAxis.Font.Height + 10) * 2
else
FPlotArea.Bottom := Height - FXAxis.Font.Height - 20;
FXFactor := (FPlotArea.Right - FPlotArea.Left) / (FXAxis.Max - FXAxis.Min) ; { X conversion factor }
FYFactor := (FPlotArea.Bottom - FPlotArea.Top) / (FYAxis.Max - FYAxis.Min) ; { Y conversion factor }
FXOffset := FXFactor * FXAxis.Min * -1; { O in the x axis }
FYOffset := FYFactor * FYAxis.Min * -1; { 0 in the y axis }
FPlot.Width := (FPlotArea.Right - FPlotArea.Left);
FPlot.Height := (FPlotArea.Bottom - FPlotArea.Top);
end;
{-------------------------
procedure TRtChart.DrawTicks(ACanvas
var
XSpacer : Single;
YSpacer : Single;
I : Integer;
MajTickCnt: Integer;
begin
XSpacer := (FPlotArea.Right - FPlotArea.Left) / FXAxis.Interval; { get interval division }
YSpacer := (FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval; { get interval division }
if ACanvas = Printer.Canvas then ACanvas.Pen.Color := clBlack
else ACanvas.Pen.Color := FBoxColor;
with ACanvas do
begin
{ Draw the grid box outline if requested }
with FPlotArea do
begin
if FBoxStyle = bsAll then
begin
MoveTo(Left , Top);
LineTo(Left , Bottom);
LineTo(Right, Bottom);
LineTo(Right, Top);
LineTo(Left , Top);
end
else
begin { Draw the XY lines if requested }
MoveTo(Left , Top);
LineTo(Left , Bottom);
LineTo(Right, Bottom);
end;
end;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
MajTickCnt := 0;
for I := 1 to FXAxis.Interval - 1 do { display the ticks }
begin
if FGridStyle <> psClear then
begin
if MajTickCnt > 3 then { draw major gridline every 5 ticks }
begin
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FGridColor;
Pen.Style := FGridStyle; { vertical grid lines }
Pen.Color := FGridColor;
MajTickCnt := 0;
MoveTo(FPlotArea.Left + (Round(XSpacer * I)), FPlotArea.Bottom);
LineTo(FPlotArea.Left + (Round(XSpacer * I)), FPlotArea.Top);
Pen.Style := psSolid;
Pen.Color := FBoxColor;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
end
else Inc(MajTickCnt);
end;
MoveTo(FPlotArea.Left+(Rou
LineTo(FPlotArea.Left+(Rou
if FBoxStyle = bsAll then
begin
MoveTo(FPlotArea.Left+(Rou
LineTo(FPlotArea.Left+(Rou
end;
end;
MoveTo(FPlotArea.Right,FPl
LineTo(FPlotArea.Right,FPl
MajTickCnt :=0;
for I := 1 to FYAxis.Interval - 1 do
begin
if FGridStyle <> psClear then
begin
if MajTickCnt > 3 then { draw major gridline every 5 ticks }
begin
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FGridColor;
Pen.Style := FGridStyle; { horizontal grid lines }
Pen.Color := FGridColor;
MajTickCnt := 0;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Right,FPl
Pen.Style := psSolid;
Pen.Color := FBoxColor;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
end
else Inc(MajTickCnt);
end;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Left+FTic
if FBoxStyle = bsAll then
begin
MoveTo(FPlotArea.Right,FPl
LineTo(FPlotArea.Right-FTi
end;
end;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Left+FTic
end;
end;
{-------------------------
procedure TRtChart.DrawTitles(ACanva
var
TextX, TextY, I: Integer;
XSpacer, YSpacer, AxisValue: Single;
ValStr: String;
begin { get major tick axis label division }
XSpacer := ((FPlotArea.Right-FPlotAre
TextY := FPlotArea.Bottom + 5;
with ACanvas do
begin
Font.Assign(FXAxis.Font); { get x asis font setup }
if ACanvas = Printer.Canvas then Font.Color := clBlack;
for I := 0 to Round(FXAxis.Interval / 5) do
begin
AxisValue := FXAxis.Min + (I * (FXAxis.Max - FXAxis.Min) / (FXAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextX := Round(I * XSpacer + FPlotArea.Left);
TextOut(Round(TextX - (TextWidth(ValStr) / 2)), TextY , ValStr);
end;
Font.Assign(FYAxis.Font); { get y axis font setup }
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := FPlotArea.Left - 5;
YSpacer := ((FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval) * 5;
for I := 0 to Round(FYAxis.Interval / 5) do
begin
AxisValue := FYAxis.Min + (I * (FYAxis.Max - FYAxis.Min) / (FYAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextY := Round(FPlotArea.Bottom - (I * YSpacer) - (TextHeight(ValStr) / 2));
if (FXAxis.Min <> FYAxis.Min) or (AxisValue <> FXAxis.Min) then
TextOut(Round(TextX - TextWidth(ValStr)), TextY, ValStr);
end;
Font.Assign(FY2Axis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := FPlotArea.Right + 5;
YSpacer := ((FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval) * 5;
for I := 0 to Round(FYAxis.Interval / 5) do
begin
AxisValue := FY2Axis.Min + (I * (FY2Axis.Max - FY2Axis.Min) / (FYAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextY := Round(FPlotArea.Bottom - (I * YSpacer) - (TextHeight(ValStr) / 2));
// if (FXAxis.Min <> FXAxis.Min) or (AxisValue <> FXAxis.Min) then
// TextOut(Round(TextX - TextWidth(ValStr)), TextY, ValStr);
TextOut(TextX, TextY, ValStr);
end;
if FTitle.ShowTitle then
begin { Display main Title if needed }
Font.Assign(FTitle.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := Round(((FPlotArea.Right - FPlotArea.Left) / 2) - (TextWidth(FTitle.Title) / 2)) + FPlotArea.Left;
TextY := FPlotArea.Top - TextHeight(FTitle.Title) - 10;
TextOut(TextX,TextY,FTitle
end;
if FYAxis.ShowTitle then
begin { Display Y Titles if needed }
Font.Assign(FYAxis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
TextX := 5;
TextOut(TextX,TextY,FYAxis
end;
if FY2Axis.ShowTitle then
begin { Display Y2 Titles if needed }
Font.Assign(FY2Axis.Font);
if ACanvas = Printer.Canvas then
begin
Font.Color := clBlack;
TextX := Printer.PageWidth - TextWidth(FY2Axis.Title) - 5;
TextY := Printer.PageHeight - TextHeight(FY2Axis.Title) - 5;
end
else begin
TextX := Width - TextWidth(FY2Axis.Title) - 5;
TextY := Height - TextHeight(FY2Axis.Title) - 5;
end;
TextOut(TextX,TextY,FY2Axi
end;
if FXAxis.ShowTitle then
begin { Display X Titles if needed }
Font.Assign(FXAxis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := Round(((FPlotArea.Right + FPlotArea.left) / 2) - (TextWidth(FXAxis.Title) / 2));
if ACanvas = Printer.Canvas then TextY := FPlotArea.Bottom + FXAxis.Font.Height + 100
else TextY := FPlotArea.Bottom + FXAxis.Font.Height + 10;
TextOut(TextX,TextY,FXAxis
end;
end;
end;
{-------------------------
procedure TRtChart.PlotPoint(AWhichS
var
MoveX, MoveY, DrawX, DrawY: Single;
DataPtr: Integer;
begin
FPlot.Canvas.Pen.Color := FData[AWhichSeries].PlotCo
FPlot.Canvas.Pen.Style := psSolid;
with FData[AWhichSeries] do
begin
DataPtr := Count - 2; { move to where the first/last point was }
MoveX := (GetX(DataPtr) * XScale * FXFactor) + FXOffset;
MoveY := FPlot.Height - GetY(DataPtr) * YScale * FYFactor - FYOffset;
DataPtr := Count - 1; { get the lasest plots points }
DrawX := (GetX(DataPtr) * XScale * FXFactor) + FXOffset;
DrawY := FPlot.Height - GetY(DataPtr) * YScale * FYFactor - FYOffset;
end;
FPlot.Canvas.MoveTo(Round(
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
case FData[AWhichSeries].PlotSt
psLines: FPlot.Canvas.LineTo(Round(
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then FPlot.Canvas.Ellipse(
Round(DrawX + 1),Round(DrawY + 1),Round(DrawX - 1),Round(DrawY - 1));
end;
Canvas.Pen.Color := FData[AWhichSeries].PlotCo
Canvas.Pen.Style := psSolid;
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
MoveX := MoveX + FPlotArea.Left;
MoveY := MoveY + FPlotArea.Top;
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
DrawX := DrawX + FPlotArea.Left;
DrawY := DrawY + FPlotArea.Top;
Canvas.MoveTo(Round(MoveX)
case FData[AWhichSeries].PlotSt
psLines: Canvas.LineTo(Round(DrawX)
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then Canvas.Ellipse(
Round(DrawX + 1),Round(DrawY + 1),Round(DrawX - 1),Round(DrawY - 1));
end;
end;
{-------------------------
{ redraws the graph if there's any data available }
procedure TRtChart.ReDrawPlot(ACanva
var
MoveX, MoveY, DrawX, DrawY: Single;
I, J: Integer;
begin
Cursor := crHourGlass;
for I := Low(FData) to High(FData) do { do all of the series }
begin
if FData[I].Show then { if wish to plot series }
begin
for J := 0 to FData[I].Count do { do all point in each series }
begin
if (FData[I].Count > 1) and (J > 1) then { see if there's more than point to plot }
begin
with ACanvas, FData[I] do
begin
Pen.Color := PlotColor;
{ move to where the first/last point was }
MoveX := GetX(J - 2) * XScale * FXFactor + FXOffset;
MoveY := AHeight - GetY(J - 2) * YScale * FYFactor - FYOffset;
{ get the lasest plots points }
DrawX := GetX(J - 1) * XScale * FXFactor + FXOffset;
DrawY := AHeight - GetY(J - 1) * YScale * FYFactor - FYOffset;
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
if ACanvas = Printer.Canvas then { offset them if printing }
begin
MoveX := MoveX + FPlotArea.Left;
MoveY := MoveY + FPlotArea.Top;
DrawX := DrawX + FPlotArea.Left;
DrawY := DrawY + FPlotArea.Top;
end;
MoveTo(Round(MoveX),Round(
case FData[I].PlotStyle of
psLines : LineTo(Round(DrawX),Round(
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then
Ellipse(Round(DrawX+1),Rou
end;
end;
end;
end;
end;
end;
Cursor := crArrow;
end;
{-------------------------
procedure TRtChart.UpDatePlot;
begin
ReSizePlot(Owner);
Paint;
end;
{-------------------------
Procedure TRtChart.AddSeries (SeriesName: String; PlotColor: TColor; PlotStyle: TPlotStyle);
begin { add a new series with parameters given }
SetLength (FData, FItems + 1);
FData[FItems] := TDataSeries.Create;
FData[FItems].PlotName := SeriesName;
FData[FItems].PlotColor := PlotColor;
FData[FItems].PlotStyle := PlotStyle;
Inc(FItems);
end;
{-------------------------
{ provides the means for multiple axis displays }
procedure TRtChart.SetLimits(XMin, XMax, YMin, YMax, XScale, YScale: Single; Num: Integer);
begin
FData[Num].XMin := XMin;
FData[Num].XMax := XMax;
FData[Num].YMin := YMin;
FData[Num].YMax := YMax;
FData[Num].XScale := XScale;
FData[Num].YScale := YScale;
end;
{-------------------------
{ removes a series given the series number }
function TRtChart.ReMoveSeries(Whic
var
SeriesCntr: Integer;
begin
if WhichSeries <= FItems then { is it a valid series number? }
begin { is is last series in set? }
if WhichSeries = Fitems then FData[WhichSeries].Destroy
else
begin
SeriesCntr := WhichSeries;
{ series in the middle so move up }
while SeriesCntr+1 <> FItems do SeriesCntr := ShiftUp(SeriesCntr);
end;
result := True; { Destroy last series as all have been moved up }
FData[FItems - 1].Destroy;
end
else result := False;
Dec(FItems);
setLength(FData, FItems); { resize the series set }
ReSizePlot(Owner);
Paint;
end;
{-------------------------
{ removes a series given the series name }
function TRtChart.ReMoveSeries(Seri
var
SeriesCntr: Integer;
begin
SeriesCntr := 1;
Result := True;
if FItems <> 1 then { Series set, not empty }
begin
while FData[SeriesCntr].PlotName
begin
if SeriesCntr = FItems-1 then { Series does not exist }
begin
Result := False;
break;
end;
inc(SeriesCntr);
end;
{ Series in the set and the rest needs to be moved up }
while (SeriesCntr + 1 <> FItems) and (Result = True) do
SeriesCntr := ShiftUp(SeriesCntr);
if Result <> False then { Series sets dealt with delete last entry }
begin
FData[FItems - 1].Destroy;
Dec(FItems);
SetLength(FData, FItems); { resize the series set }
end
end else Result := False;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.ReMoveAll;
var
I: Integer;
begin
for I:= Low(FData) to High(FData) do FData[I].free;
SetLength(FData, 0);
FItems := 0;
ReSizePlot(Self);
Paint;
end;
{-------------------------
procedure TRtChart.ClearAll;
var
I: Integer;
begin
for I:= Low(FData) to High(FData) do FData[I].Clear;
ReSizePlot(Self);
Paint;
end;
{-------------------------
procedure TRtChart.Add(X, Y : Single; SeriesNumber: Integer);
begin
FData[SeriesNumber].Add(X,
{ see if there's more than point to plot }
if (FData[SeriesNumber].Count
PlotPoint(SeriesNumber);
end;
{-------------------------
function TRtChart.ShiftUp(ASeriesCn
var
I: Integer;
begin
FData[ASeriesCntr].PlotCol
FData[ASeriesCntr].PlotSty
FData[ASeriesCntr].PlotNam
FData[ASeriesCntr].Count := FData[ASeriesCntr+1].Count
{ Transfer the X&Y Data from the next object into this object }
FData[ASeriesCntr].Clear;
for I:= Low(FData) to High(FData) do
begin
if FData[ASeriesCntr+1].Count
FData[ASeriesCntr].Add(FDa
FData[ASeriesCntr+1].GetY(
end;
inc(ASeriesCntr);
Result := ASeriesCntr;
end;
{-------------------------
procedure TRtChart.SetCoordFont(ACoo
begin
if ACoordFont <> FCoordFont then FCoordFont.Assign(ACoordFo
end;
{-------------------------
procedure TRtChart.SetTickLength(ATi
begin
if ATickLength <> FTickLength then
begin
FTickLength := ATickLength;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetGridColor(AGri
begin
if AGridColor <> FGridColor then
begin
FGridColor := AGridColor;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetBoxStyle(ABoxS
begin
if ABoxStyle <> FBoxStyle then
begin
FBoxStyle := ABoxStyle;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetGridStyle(AGri
begin
if AGridStyle <> FGridStyle then
begin
FGridStyle := AGridStyle;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetBoxColor(ABoxC
begin
if ABoxColor <> FBoxColor then
begin
FBoxColor := ABoxColor;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.MouseMove(Shift: TShiftState; X, Y: Integer);
var
XString, YString: String;
begin
Canvas.Font.Assign(FCoordF
if FPopUpItems[ChartMarker].C
{ draw zoom box only if not wishing to move a marker}
if FZooming and (ssLeft in Shift) then
begin
with Canvas do
begin
if Color = clWhite then Pen.Color := clBlack else Pen.Color := clWhite;
Pen.Style := psDot;
Pen.Mode := pmXor;
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(FMovePt.X, FOrigin.Y); { erase old lines }
LineTo(FMovePt.X, FMovePt.Y);
LineTo(FOrigin.X, FMovePt.Y);
LineTo(FOrigin.X, FOrigin.Y);
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(X, FOrigin.Y); { draw new box }
LineTo(X, Y);
LineTo(FOrigin.X, Y);
LineTo(FOrigin.X, FOrigin.Y);
Pen.Style := psSolid;
end;
FMovePt := Point(X, Y);
end;
{ Display graph and change cursor only when within plot area }
if (X >= FPlotArea.Left) and (X <= FPlotArea.Right) and
(Y >= FPlotArea.Top) and (Y <= FPlotArea.Bottom) then
begin
with Canvas do
begin
Pen.Mode := pmXor;
Pen.Color := FBoxColor;
Pen.Style := psSolid;
if FHairLines then { Draw hairlines if requested }
begin
if not FSetHairLine then
begin
MoveTo(FHairLineMovePt.X,F
LineTo(FHairLineMovePt.X,F
MoveTo(FPlotArea.Left,FHai
LineTo(FPlotArea.Right,FHa
end;
Cursor := crNone;
FSetHairLine := False;
MoveTo(X,FPlotArea.Top); { draw new lines }
LineTo(X,FPlotArea.Bottom)
MoveTo(FPlotArea.Left,Y);
LineTo(FPlotArea.Right,Y);
FHairLineMovePt := Point(X, Y);
end
{ default cursor only not moving a marker }
else if Cursor <> crMarkerCursor then Cursor := crCross;
{ display real coord values }
FCoord.Canvas.Brush.Color := Color;
XString := ' X = ' + FormatFloat('0.00', (X - FPlotArea.Left - FXOffset) / FXFactor);
YString := ' Y = ' + FormatFloat('0.00', (FPlotArea.Bottom - Y - FYOffset) / FYFactor);
with FCoord.Canvas do
begin
if TextWidth(XString) > TextWidth(YString) then FCoord.Width := TextWidth(XString)
else FCoord.Width := TextWidth(YString);
FCoord.Height := TextHeight(XString) + TextHeight(YString);
FCoord.Canvas.FillRect(Rec
TextOut(0,0,XString);
TextOut(0,TextHeight(YStri
end;
end;
end
else
begin
Cursor := crArrow;
with Canvas do
begin { cursor out of range so don't display cursor position }
FCoord.Canvas.Brush.Color := Color;
XString := ' X = ????';
YString := ' Y = ????';
with FCoord.Canvas do
begin
if TextWidth(XString) > TextWidth(YString) then FCoord.Width := TextWidth(XString)
else FCoord.Width := TextWidth(YString);
FCoord.Height := TextHeight(XString) + TextHeight(YString);
TextOut(0,0,XString);
TextOut(0,TextHeight(YStri
end;
end;
end;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
Canvas.Draw(Width - FCoord.Width - 5, 5 + FMarker.Height, FCoord)
else
Canvas.Draw(Width - FCoord.Width - 5, 5, FCoord);
Canvas.Pen.Mode := pmCopy;
end;
{-------------------------
procedure TRtChart.MouseDown(Button:
begin
if FPlotting then PopUpMenu := nil else PopUpMenu := FRtChartPopUp;
{ within upper marker limit }
with FMarker.Upper do
begin
if (X > Point.x - 5)and(X < Point.x + 5)and(Y > Point.y - 15)and(Y < Point.y) then
begin
Cursor := crMarkerCursor;
FMarker.Lower.Selected := False; { make sure only one marker is moving at one time }
with FMarker.Upper do
if (ssLeft in Shift) then Selected := True else Selected := False;
end;
end;
with FMarker.Lower do { within Lower marker limit }
begin
if (X > Point.x - 5)and(X < Point.x + 5)and(Y > Point.y)and(Y < Point.y + 15) then
begin
Cursor := crMarkerCursor;
FMarker.Upper.Selected := False; { make sure only one marker is moving at one time }
if (ssLeft in Shift) then Selected := True else Selected := False;
end;
end;
{ user wanting to zoom in }
if (Button = mbLeft) and not FMarker.Upper.Selected and not FMarker.Lower.Selected then
begin
Canvas.MoveTo(X,Y);
FZooming := True;
FOrigin := Point(X, Y);
FMovePt := Point(X, Y);
end;
end;
{-------------------------
procedure TRtChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{ only zoom in if not tring to move a marker or if previous point is the same as the
now point. }
if FZooming and (FOrigin.X <> FMovePt.X) and (FOrigin.Y <> FMovePt.Y) and
not FMarker.Upper.Selected and not FMarker.Lower.Selected then
begin
FZooming := False;
with Canvas do
begin
Pen.Mode := pmXor;
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(FMovePt.X, FOrigin.Y); { erase old lines }
LineTo(FMovePt.X, FMovePt.Y);
LineTo(FOrigin.X, FMovePt.Y);
LineTo(FOrigin.X, FOrigin.Y);
Pen.Mode := pmCopy;
end;
ZoomIn(FOrigin,FMovePt);
end;
FMarker.Upper.Selected := False; {disable the abiltity to redraw markers }
FMarker.Lower.Selected := False;
end;
{-------------------------
procedure TRtChart.DrawMarker(DrawNe
var
TmpX, TmpY: Integer;
begin
with FData[FMarker.DataIdx], FMarker, FPlotArea do
begin
TmpX := Round(Left + GetX(Upper.Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Upper.Idx)* FYFactor * YScale) - FYOffset);
Upper.Point := Point(TmpX, TmpY);
TmpX := Round(Left + GetX(Lower.Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Lower.Idx)* FYFactor * YScale) - FYOffset);
Lower.Point := Point(TmpX, TmpY);
end;
if not WhichMarker then
begin
{ erase old upper marker or redraw new }
Canvas.MoveTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
end
else
begin
{ erase old upper marker or redraw new }
Canvas.MoveTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
end;
if not DrawNew then exit;
if not WhichMarker then
begin
{ draw new upper marker }
Canvas.MoveTo(Round(X) , Round(Y) );
Canvas.LineTo(Round(X) - 5, Round(Y) -15);
Canvas.LineTo(Round(X) + 5, Round(Y) -15);
Canvas.LineTo(Round(X) , Round(Y));
end
else
begin
{ draw new lower marker }
Canvas.MoveTo(Round(X) , Round(Y) );
Canvas.LineTo(Round(X) - 5, Round(Y) +15);
Canvas.LineTo(Round(X) + 5, Round(Y) +15);
Canvas.LineTo(Round(X) , Round(Y));
end;
end;
{-------------------------
procedure TRtChart.MoveMarker(AShift
var
I: Integer;
NewX, NewY: Single;
begin
Cursor := crCross; { set to default cursor if not moving a marker }
with FMarker.Upper.Point do
begin
if (AX > x - 5)and(AX < x + 5)and(AY > y - 15)and(AY < y) then
Cursor := crMarkerCursor; { within upper marker limit change cursor }
end;
with FMarker.Lower.Point do
begin
if (AX > x - 5)and(AX < x + 5)and(AY > y)and(AY < y + 15) then
Cursor := crMarkerCursor; { within lower marker limit change cursor }
end;
{ draw upper marker new position }
if FMarker.Upper.Selected or FMarker.Lower.Selected and (ssLeft in AShift) then
begin
for I:= 0 to FData[FMarker.DataIdx].Cou
begin
with FData[FMarker.DataIdx], FPlotArea do
begin
NewX := Left + GetX(I) * FXFactor * XScale + FXOffset;
NewY := Top + FPlot.Height - (GetY(I) * FYFactor * YScale) - FYOffset;
end;
if (NewY > AY - 10)and(NewY < AY + 10)and(NewX > AX - 10)and(NewX < AX + 10) then
begin
if FMarker.Upper.Selected then
begin
{ display the coordinates of the upper marker }
with FData[FMarker.DataIdx] do ShowMarkerCoord(GetX(I), GetY(I), False);
Canvas.Pen.Mode := pmXor;
DrawMarker(True, NewX, NewY, False);
Canvas.Pen.Mode := pmCopy;
FMarker.Upper.Idx := I;
FMarker.Upper.Point := Point(Round(NewX), Round(NewY));
end
else
begin
{ display the coordinates of the lower marker }
with FData[FMarker.DataIdx] do ShowMarkerCoord(GetX(I), GetY(I), True);
Canvas.Pen.Mode := pmXor;
DrawMarker(True, NewX, NewY, True);
Canvas.Pen.Mode := pmCopy;
FMarker.Lower.Idx := I;
FMarker.Lower.Point := Point(Round(NewX), Round(NewY));
end;
end;
end;
end;
Canvas.Draw(0, 0, FMarker);
end;
{-------------------------
procedure TRtChart.Print;
var
FPrintDialog : TPrintDialog;
BackupFPlotArea, PrtGrid : TRect;
MaxWidth, MinWidth: Integer;
OldXFactor, OldYFactor, OldXOffset, OldYOffset: Single;
begin
OldXFactor := FXFactor;
OldYFactor := FYFactor;
OldXOffset := FXOffset;
OldYOffset := FYOffset;
FPrintDialog := TPrintDialog.Create(Self);
if FPrintDialog.Execute then
begin
Printer.Title := 'Servocon Plot';
Printer.BeginDoc; { start printing }
with Printer.Canvas do
begin
if FTitle.ShowTitle then PrtGrid.Top := 100 + TextHeight(FTitle.Title) + 100
else PrtGrid.Top := 100 + TextHeight(FTitle.Title);
MaxWidth := Round(TextWidth(FormatFloa
MinWidth := Round(TextWidth(FormatFloa
if FYAxis.Max > FYAxis.Min then PrtGrid.Left := 50 + MaxWidth
else PrtGrid.Left := 50 + MinWidth;
MaxWidth := Round(TextWidth(FormatFloa
MinWidth := Round(TextWidth(FormatFloa
if FY2Axis.Max > FY2Axis.Min then PrtGrid.Right := Printer.PageWidth - (10 + MaxWidth)
else PrtGrid.Right := Printer.PageWidth - (10 + MinWidth);
if FXAxis.ShowTitle then
PrtGrid.Bottom := Printer.PageHeight - (TextHeight(FXAxis.Title)+
else
PrtGrid.Bottom := Printer.PageHeight - TextHeight(FXAxis.Title) - 100;
end;
BackupFPlotArea := FPlotArea;
FPlotArea := PrtGrid;
FXFactor := (FPlotArea.Right - FPlotArea.Left) / (FXAxis.Max - FXAxis.Min) ; { X conversion factor }
FYFactor := (FPlotArea.Bottom - FPlotArea.Top) / (FYAxis.Max - FYAxis.Min) ; { Y conversion factor }
FXOffset := FXFactor * FXAxis.Min * -1; { O in the x axis }
FYOffset := FYFactor * FYAxis.Min * -1; { 0 in the y axis }
DrawTitles(Printer.Canvas)
DrawTicks(Printer.Canvas);
ReDrawPlot(Printer.Canvas,
FPlotArea := BackupFPlotArea;
Printer.EndDoc; { finish printing }
end;
FPrintDialog.Free;
FXFactor := OldXFactor;
FYFactor := OldYFactor;
FXOffset := OldXOffset;
FYOffset := OldYOffset;
end;
{-------------------------
procedure TRtChart.ZoomIn(AStartPoin
var
TempCopy: Single;
begin
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
{ User drawn zoom box normally i.e. top left to bottom right }
if AStartPoint.X <= AEndPoint.X then
begin
TempCopy := FXAxis.Min;
FXAxis.Min := FXAxis.Min + ((AStartPoint.X - FPlotArea.Left) / FXFactor);
FXAxis.Max := TempCopy + ((AEndPoint.X - FPlotArea.Left) / FXFactor);
end
else { User drawn zoom box abnormally i.e. bottom right to top left}
begin
TempCopy := FXAxis.Min;
FXAxis.Min := FXAxis.Min + ((AEndPoint.X - FPlotArea.Left) / FXFactor);
FXAxis.Max := TempCopy + ((AStartPoint.X - FPlotArea.Left) / FXFactor);
end;
{ User drawn zoom box normally i.e. top left to bottom right }
if AStartPoint.Y <= AEndPoint.Y then
begin
TempCopy := FYAxis.Max;
FYAxis.Max := FYAxis.Max - ((AStartPoint.Y - FPlotArea.Top) / FYFactor);
FYAxis.Min := TempCopy - ((AEndPoint.Y - FPlotArea.Top) / FYFactor);
end
else { User drawn zoom box abnormally i.e. bottom right to top left}
begin
TempCopy := FYAxis.Max;
FYAxis.Max := FYAxis.Max - ((AEndPoint.Y - FPlotArea.Top) / FYFactor);
FYAxis.Min := TempCopy - ((AStartPoint.Y - FPlotArea.Top) / FYFactor);
end;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.ResetPlot;
begin
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
FXAxis.Max := FOld.X.Max;
FXAxis.Min := FOld.X.Min;
FYAxis.Max := FOld.Y.Max;
FYAxis.Min := FOld.Y.Min;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.PrintClick(Sender
begin
Print;
end;
{-------------------------
procedure TRtChart.ResetZoomClick(Se
begin
ResetPlot;
end;
{-------------------------
procedure TRtChart.SetupPopUp;
var
PrintImage : TBitMap;
Zoom1Image : TBitMap;
CenterImage : TBitMap;
CopyClipImage : TBitMap;
NextPLotImage : TBitMap;
PrevPlotImage : TBitMap;
AutoScaleImage: TBitMap;
begin
FRtChartPopUp := TPopUpMenu.Create(Self);
FImageList := TImageList.Create(Self);
PopUpMenu := FRtChartPopUp;
PopUpMenu.Images := FImageList;
PrintImage := TBitmap.Create;
PrintImage.LoadFromResourc
PrintImage.Transparent := True;
FPopUpItems[0] := TMenuItem.Create(Self);
FImageList.AddMasked(Print
FPopUpItems[0].ImageIndex := 0;
FPopUpItems[0].Caption := '&Print';
FPopUpItems[0].OnClick := PrintClick;
FRtChartPopUp.Items.Add(FP
FPopUpItems[1] := TMenuItem.Create(Self);
FPopUpItems[1].Caption := '-';
FRtChartPopUp.Items.Add(FP
Zoom1Image := TBitmap.Create;
Zoom1Image.LoadFromResourc
Zoom1Image.Transparent := True;
FPopUpItems[2] := TMenuItem.Create(Self);
FImageList.AddMasked(Zoom1
FPopUpItems[2].ImageIndex := 1;
FPopUpItems[2].Caption := '&Zoom x1';
FPopUpItems[2].OnClick := ResetZoomClick;
FRtChartPopUp.Items.Add(FP
AutoScaleImage := TBitmap.Create;
AutoScaleImage.LoadFromRes
AutoScaleImage.Transparent
FPopUpItems[3] := TMenuItem.Create(Self);
FImageList.AddMasked(AutoS
FPopUpItems[3].ImageIndex := 2;
FPopUpItems[3].Caption := '&Auto Scale';
FPopUpItems[3].OnClick := AutoScaleClick;
FRtChartPopUp.Items.Add(FP
FPopUpItems[4] := TMenuItem.Create(Self);
FPopUpItems[4].Caption := '-';
FRtChartPopUp.Items.Add(FP
FPopUpItems[ChartMarker] := TMenuItem.Create(Self);
FPopUpItems[ChartMarker].C
FPopUpItems[ChartMarker].O
FRtChartPopUp.Items.Add(FP
CenterImage := TBitmap.Create;
CenterImage.LoadFromResour
CenterImage.Transparent := True;
FPopUpItems[6] := TMenuItem.Create(Self);
FImageList.AddMasked(Cente
FPopUpItems[6].ImageIndex := 3;
FPopUpItems[6].Caption := 'Center &Markers';
FPopUpItems[6].OnClick := CenterMarkersClick;
FPopUpItems[6].Enabled := False;
FRtChartPopUp.Items.Add(FP
FPopUpItems[7] := TMenuItem.Create(Self);
FPopUpItems[7].Caption := '-';
FRtChartPopUp.Items.Add(FP
NextPlotImage := TBitmap.Create;
NextPlotImage.LoadFromReso
NextPlotImage.Transparent := True;
FPopUpItems[8] := TMenuItem.Create(Self);
FImageList.AddMasked(NextP
FPopUpItems[8].ImageIndex := 4;
FPopUpItems[8].Caption := 'Mark &Next Plot';
FPopUpItems[8].OnClick := NextPlotClick;
FPopUpItems[8].Enabled := False;
FRtChartPopUp.Items.Add(FP
PrevPlotImage := TBitmap.Create;
PrevPlotImage.LoadFromReso
PrevPlotImage.Transparent := True;
FPopUpItems[9] := TMenuItem.Create(Self);
FImageList.AddMasked(PrevP
FPopUpItems[9].ImageIndex := 5;
FPopUpItems[9].Caption := 'Mark P&rev Plot';
FPopUpItems[9].OnClick := PrevPlotClick;
FPopUpItems[9].Enabled := False;
FRtChartPopUp.Items.Add(FP
FPopUpItems[10] := TMenuItem.Create(Self);
FPopUpItems[10].Caption := '-';
FRtChartPopUp.Items.Add(FP
CopyClipImage := TBitmap.Create;
CopyClipImage.LoadFromReso
CopyClipImage.Transparent := True;
FPopUpItems[11] := TMenuItem.Create(Self);
FImageList.AddMasked(CopyC
FPopUpItems[11].ImageIndex
FPopUpItems[11].BitMap := CopyClipImage;
FPopUpItems[11].Caption := '&Copy to ClipBoard';
FPopUpItems[11].OnClick := CopyClipBoardClick;
FRtChartPopUp.Items.Add(FP
AutoScaleImage.Free;
PrintImage.Free;
Zoom1Image.Free;
CenterImage.Free;
CopyClipImage.Free;
NextPLotImage.Free;
PrevPlotImage.Free;
end;
{-------------------------
procedure TRtChart.ShowMarkersClick(
var
TmpX, TmpY, Idx: Integer;
Begin
if FPopUpItems[ChartMarker].C
else FPopUpItems[ChartMarker].C
if FPopUpItems[ChartMarker].C
begin
if FItems > 0 then { if no plot data don't show markers and bring up an error }
begin
FMarker.DataIdx := 0;
FMarker.Upper.Idx := Round(FData[0].Count / 2);
FMarker.Lower.Idx := Round(FData[0].Count / 2);
Idx := FMarker.Upper.Idx;
with FData[0], FPlotArea do
begin
TmpX := Round(Left + GetX(Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Idx)* FYFactor * YScale) - FYOffset);
end;
FMarker.Upper.Point := Point(TmpX, TmpY);
FMarker.Lower.Point := Point(TmpX, TmpY);
ResizePlot(Owner);
Paint; { first paint screen with new limits }
DrawMarker(True, 0, 0, False);
DrawMarker(True, 0, 0, True);
FPopUpItems[ChartMarker].C
if FItems < 2 then
FPopUpItems[CntrMarker].En
else
begin
FPopUpItems[CntrMarker].En
FPopUpItems[NextMarker].En
end;
end
else
begin
Application.MessageBox('No
FPopUpItems[ChartMarker].C
end;
end
else
begin { disable marker routines is there are markers on the graph }
FPopUpItems[CntrMarker].En
FPopUpItems[NextMarker].En
FPopUpItems[PrevMarker].En
ResizePlot(Owner);
Paint; { removed markers refresh screen }
end;
end;
{-------------------------
procedure TRtChart.CenterMarkersClic
var
Idx, TmpX, TmpY: Integer;
Begin
FMarker.Upper.Idx := Round(FData[FMarker.DataId
FMarker.Lower.Idx := Round(FData[FMarker.DataId
Idx := FMarker.Upper.Idx;
with FData[FMarker.DataIdx], FPlotArea do
begin
TmpX := Round(Left + GetX(Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Idx)* FYFactor * YScale) - FYOffset);
end;
FMarker.Upper.Point := Point(TmpX, TmpY);
FMarker.Lower.Point := Point(TmpX, TmpY);
Paint; { first paint screen with new limits }
end;
{-------------------------
procedure TRtChart.NextPlotClick(Sen
begin
if FMarker.DataIdx < FItems-1 then
begin
FPopUpItems[PrevMarker].En
FMarker.DataIdx := FMarker.DataIdx + 1; { inc dataidx }
if FMarker.DataIdx = FItems - 1 then
FPopUpItems[NextMarker].En
else FPopUpItems[NextMarker].En
FMarker.Lower.Idx := Round(FData[FMarker.DataId
FMarker.Upper.Idx := Round(FData[FMarker.DataId
ReSizePlot(Owner);
Paint;
end
end;
{-------------------------
procedure TRtChart.PrevPlotClick(Sen
begin
if FMarker.DataIdx > 0 then
begin
FPopUpItems[NextMarker].En
FMarker.DataIdx := FMarker.DataIdx - 1;
if FMarker.DataIdx = 0 then FPopUpItems[PrevMarker].En
else FPopUpItems[PrevMarker].En
FMarker.Lower.Idx := Round(FData[FMarker.DataId
FMarker.Upper.Idx := Round(FData[FMarker.DataId
ReSizePlot(Owner);
Paint;
end
end;
{-------------------------
procedure TRtChart.CopyClipBoardClic
var
GraphCopy: TBitMap;
Source, Dest: TRect;
Begin
Source.Left := 0;
Source.Top := 0;
Source.Bottom := Height;
Source.Right := Width;
Dest := Source;
GraphCopy := TBitMap.Create;
GraphCopy.Height := Height;
GraphCopy.Width := Width;
GraphCopy.Canvas.CopyRect(
Clipboard.Open;
try
Clipboard.Assign(GraphCopy
finally
Clipboard.Close;
end;
GraphCopy.Free;
end;
{-------------------------
procedure TRtChart.PlotOpen(FileName
var
FileHeaderData : TFileHeader;
FilePointsData : TFilePoints;
FileSeriesData : TFileSeries;
iFileHandle, iFileLength, SeriesCount, I: Integer;
begin
iFileHandle := FileOpen(FileName, fmOpenRead);
iFileLength := FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
FileRead(IFileHandle, FileHeaderData, SizeOf(FileHeaderData));
if FileHeaderData.GraphFormat
begin
{ start loading the plot from file }
SeriesCount := FileHeaderData.Count;
FTitle.Title := FileHeaderData.Title.Title
FTitle.ShowTitle := FileHeaderData.Title.ShowT
FTitle.Font.Name := FileHeaderData.Title.Font.
FTitle.Font.Height := FileHeaderData.Title.Font.
FTitle.Font.Color := FileHeaderData.Title.Font.
FTitle.Font.Style := FileHeaderData.Title.Font.
FXAxis.Title := FileHeaderData.XAxis.Title
FXAxis.ShowTitle := FileHeaderData.XAxis.ShowT
FXAxis.Font.Name := FileHeaderData.XAxis.Font.
FXAxis.Font.Height := FileHeaderData.XAxis.Font.
FXAxis.Font.Color := FileHeaderData.XAxis.Font.
FXAxis.Font.Style := FileHeaderData.XAxis.Font.
FXAxis.Interval := FileHeaderData.XAxis.Inter
FXAxis.Max := FileHeaderData.XAxis.Max;
FXAxis.Min := FileHeaderData.XAxis.Min;
FXAxis.Style := FileHeaderData.XAxis.Style
FYAxis.Title := FileHeaderData.YAxis.Title
FYAxis.ShowTitle := FileHeaderData.YAxis.ShowT
FYAxis.Font.Name := FileHeaderData.YAxis.Font.
FYAxis.Font.Height := FileHeaderData.YAxis.Font.
FYAxis.Font.Color := FileHeaderData.YAxis.Font.
FYAxis.Font.Style := FileHeaderData.YAxis.Font.
FYAxis.Interval := FileHeaderData.YAxis.Inter
FYAxis.Max := FileHeaderData.YAxis.Max;
FYAxis.Min := FileHeaderData.YAxis.Min;
FYAxis.Style := FileHeaderData.YAxis.Style
Color := FileHeaderData.BoxColor;
FBoxStyle := FileHeaderData.BoxStyle;
FGridStyle := FileHeaderData.GridStyle;
FGridColor := FileHeaderData.GridColor;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
for I := 0 to SeriesCount - 1 do
begin
FileRead(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
with FileSeriesData do
begin
AddSeries(PlotName, PlotColor, PlotStyle);
SetLimits(XMin, XMax, YMin, YMax, XScale, YScale, SeriesNumber);
end;
end;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
repeat
FileRead(iFileHandle, FilePointsData, SizeOf(FilePointsData));
Add(FilePointsData.XPoint,
until FileSeek(iFileHandle, 0, 1) = iFileLength;
FileClose(iFileHandle);
end
else
begin
FileClose(iFileHandle);
Application.MessageBox('In
'Real Time Chart',MB_OK+MB_ICONINFORM
end;
end;
{-------------------------
procedure TRtChart.PlotSave(FileName
var
iFileHandle: Integer;
FileHeaderData : TFileHeader;
FilePointsData : TFilePoints;
FileSeriesData : TFileSeries;
I, J : Integer;
begin
iFileHandle := FileCreate(FileName);
{ setup record for writting }
FileHeaderData.GraphFormat
FileHeaderData.VerNum := 1;
FileHeaderData.Count := Count;
FileHeaderData.Title.Title
FileHeaderData.Title.ShowT
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.XAxis.Title
FileHeaderData.XAxis.ShowT
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Inter
FileHeaderData.XAxis.Max := FXAxis.Max;
FileHeaderData.XAxis.Min := FXAxis.Min;
FileHeaderData.XAxis.Style
FileHeaderData.YAxis.Title
FileHeaderData.YAxis.ShowT
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Inter
FileHeaderData.YAxis.Max := FYAxis.Max;
FileHeaderData.YAxis.Min := FYAxis.Min;
FileHeaderData.YAxis.Style
FileHeaderData.BoxColor := Color;
FileHeaderData.BoxStyle := FBoxStyle;
FileHeaderData.GridStyle := FGridStyle;
FileHeaderData.GridColor := FGridColor;
{ write record }
FileWrite(iFileHandle, FileHeaderData, SizeOf(FileHeaderData));
{ change the record to write the plot data }
{ Save Series information }
for I := Low(FData) to High(FData) do
begin
FileSeriesData.SeriesNumbe
FileSeriesData.PlotName := FData[I].PlotName;
FileSeriesData.PlotColor := FData[I].PlotColor;
FileSeriesData.PlotStyle := FData[I].PlotStyle;
FileSeriesData.XMax := FData[I].XMax;
FileSeriesData.XMin := FData[I].XMin;
FileSeriesData.YMax := FData[I].YMax;
FileSeriesData.YMin := FData[I].YMin;
FileSeriesData.XScale := FData[I].XScale;
FileSeriesData.YScale := FData[I].YScale;
{ write a single plot }
FileWrite(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
end;
{ change the record to write the plot data }
for I:= Low(FData) to High(FData) do
begin
for J:= 0 to FData[I].Count - 1 do
begin
FilePointsData.SeriesNumbe
FilePointsData.XPoint := FData[I].GetX(J);
FilePointsData.YPoint := FData[I].GetY(J);
{ write a single plot }
FileWrite(iFileHandle, FilePointsData, SizeOf(FilePointsData));
end;
end;
FileClose(IFileHandle);
end;
{-------------------------
procedure TRtChart.SetDefaults(FileN
var
iFileHandle, I: Integer;
FileHeaderData : TFileHeader;
FileSeriesData : TFileSeries;
begin
iFileHandle := FileCreate(FileName);
{ setup record for writting }
FileHeaderData.GraphFormat
FileHeaderData.VerNum := 1;
FileHeaderData.Count := Count;
FileHeaderData.Title.Title
FileHeaderData.Title.ShowT
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.XAxis.Title
FileHeaderData.XAxis.ShowT
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Inter
FileHeaderData.XAxis.Max := FXAxis.Max;
FileHeaderData.XAxis.Min := FXAxis.Min;
FileHeaderData.XAxis.Style
FileHeaderData.YAxis.Title
FileHeaderData.YAxis.ShowT
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Inter
FileHeaderData.YAxis.Max := FYAxis.Max;
FileHeaderData.YAxis.Min := FYAxis.Min;
FileHeaderData.YAxis.Style
FileHeaderData.BoxColor := Color;
FileHeaderData.BoxStyle := FBoxStyle;
FileHeaderData.GridStyle := FGridStyle;
FileHeaderData.GridColor := FGridColor;
{ write record }
FileWrite(iFileHandle, FileHeaderData, SizeOf(FileHeaderData));
{ change the record to write the plot data }
{ Save Series information }
for I := Low(FData) to High(FData) do
begin
FileSeriesData.SeriesNumbe
FileSeriesData.PlotName := FData[I].PlotName;
FileSeriesData.PlotColor := FData[I].PlotColor;
FileSeriesData.PlotStyle := FData[I].PlotStyle;
FileSeriesData.XMax := FData[I].XMax;
FileSeriesData.XMin := FData[I].XMin;
FileSeriesData.YMax := FData[I].YMax;
FileSeriesData.YMin := FData[I].YMin;
FileSeriesData.XScale := FData[I].XScale;
FileSeriesData.YScale := FData[I].YScale;
{ write a single plot }
FileWrite(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
end;
FileClose(iFileHandle);
end;
{-------------------------
procedure TRtChart.GetDefaults(FileN
var
FileHeaderData : TFileHeader;
FileSeriesData : TFileSeries;
iFileHandle, iFileLength, SeriesCount, I: Integer;
begin
iFileHandle := FileOpen(FileName, fmOpenRead);
iFileLength := FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
FileRead(IFileHandle, FileHeaderData, SizeOf(FileHeaderData));
if FileHeaderData.GraphFormat
begin
{ start loading the plot from file }
SeriesCount := FileHeaderData.Count;
FTitle.Title := FileHeaderData.Title.Title
FTitle.ShowTitle := FileHeaderData.Title.ShowT
FTitle.Font.Name := FileHeaderData.Title.Font.
FTitle.Font.Height := FileHeaderData.Title.Font.
FTitle.Font.Color := FileHeaderData.Title.Font.
FTitle.Font.Style := FileHeaderData.Title.Font.
FXAxis.Title := FileHeaderData.XAxis.Title
FXAxis.ShowTitle := FileHeaderData.XAxis.ShowT
FXAxis.Font.Name := FileHeaderData.XAxis.Font.
FXAxis.Font.Height := FileHeaderData.XAxis.Font.
FXAxis.Font.Color := FileHeaderData.XAxis.Font.
FXAxis.Font.Style := FileHeaderData.XAxis.Font.
FXAxis.Interval := FileHeaderData.XAxis.Inter
FXAxis.Max := FileHeaderData.XAxis.Max;
FXAxis.Min := FileHeaderData.XAxis.Min;
FXAxis.Style := FileHeaderData.XAxis.Style
FYAxis.Title := FileHeaderData.YAxis.Title
FYAxis.ShowTitle := FileHeaderData.YAxis.ShowT
FYAxis.Font.Name := FileHeaderData.YAxis.Font.
FYAxis.Font.Height := FileHeaderData.YAxis.Font.
FYAxis.Font.Color := FileHeaderData.YAxis.Font.
FYAxis.Font.Style := FileHeaderData.YAxis.Font.
FYAxis.Interval := FileHeaderData.YAxis.Inter
FYAxis.Max := FileHeaderData.YAxis.Max;
FYAxis.Min := FileHeaderData.YAxis.Min;
FYAxis.Style := FileHeaderData.YAxis.Style
Color := FileHeaderData.BoxColor;
FBoxStyle := FileHeaderData.BoxStyle;
FGridStyle := FileHeaderData.GridStyle;
FGridColor := FileHeaderData.GridColor;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
for I := 0 to SeriesCount - 1 do
begin
FileRead(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
with FileSeriesData do
begin
AddSeries(PlotName, PlotColor, PlotStyle);
SetLimits(XMin, XMax, YMin, YMax, XScale, YScale, SeriesNumber);
end;
end;
end;
FileClose(iFileHandle);
end;
{-------------------------
procedure TRtChart.PlotCsvExport(Fil
var
SaveDialog: TSaveDialog;
I, J: Integer;
ExportCsvFile: TextFile;
begin
if FItems > 0 then { can't export nothing! }
begin
{ setup the save file dialog }
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.Filter := 'Chart file (*.scd)|*.scd';
SaveDialog.FileName := 'Chart';
SaveDialog.Title := 'Save Chart As ';
SaveDialog.DefaultExt := 'xxx';
SaveDialog.Options := [ofOverwritePrompt];
if SaveDialog.Execute then { if user selected a file }
begin
AssignFile(ExportCsvFile,S
ReWrite(ExportCsvFile);
try
Write(ExportCsvFile,FData[
{ write all of the plot names }
for I:= Low(FData) to High(FData) do Write(ExportCsvFile,FData[
Writeln(ExportCsvFile);
Write(ExportCsvFile,'X');{
{ write Y for each series }
for I:= Low(FData) to High(FData) do Write(ExportCsvFile,',Y');
Writeln(ExportCsvFile);
{ write all points comma seperated }
for I:= 1 to FData[1].Count do
begin
Write(ExportCsvFile,FloatT
for J:= Low(FData) to High(FData) do
Write(ExportCsvFile,FloatT
Writeln(ExportCsvFile);
end;
finally
CloseFile(ExportCsvFile);
end;
SaveDialog.Free;
end;
end
else Application.MessageBox('No
end;
{-------------------------
procedure TRtChart.PlotExcelExport;
var
frmExport : TfrmExport;
begin
if FItems > 0 then { can't export nothing! }
begin
frmExport := TfrmExport.CreateWithChart
frmExport.Show;
frmExport.DoExport;
frmExport.Free;
end
else Application.MessageBox('No
end;
{-------------------------
procedure TRtChart.AutoScaleClick(Se
var
NewXMin, NewXMax : Single;
NewYMin, NewYMax : Single;
I, J : Integer;
begin
Cursor := crHourGlass;
if (FItems > 0) and (FData[0].Count > 1) then
begin
with FData[0] do
begin
NewXMin := GetX(0) * XScale;
NewXMax := GetX(0) * XScale;
NewYMin := GetY(0) * YScale;
NewYMax := GetY(0) * YScale;
end;
for I := Low(FData) to High(FData) do
begin
for J := 0 to FData[I].Count do
begin
with FData[I] do
begin
if (GetX(J) * XScale) > NewXMax then NewXMax := GetX(J) * XScale;
if (GetX(J) * XScale) < NewXMin then NewXMin := GetX(J) * XScale;
if (GetY(J) * YScale) > NewYMax then NewYMax := GetY(J) * YScale;
if (GetY(J) * YScale) < NewYMin then NewYMin := GetY(J) * YScale;
end;
end;
end;
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
FXAxis.Max := NewXMax;
FXAxis.Min := NewXMin;
FYAxis.Max := NewYMax;
FYAxis.Min := NewYMin;
FOld.X.Max := NewXMax;
FOld.X.Min := NewXMin;
FOld.Y.Max := NewYMax;
FOld.Y.Min := NewYMin;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.ShowMarkerCoord(A
var
UpperMarkerImage, LowerMarkerImage, XYMarkerImage: TBitMap;
GradX, GradY: Single;
TmpStr: String;
begin
FMarker.Canvas.Brush.Color
FMarker.Canvas.Font.Color := clBlack;
if not AWhichMarker then
begin
UpperMarkerImage := TBitmap.Create;
UpperMarkerImage.LoadFromR
UpperMarkerImage.Transpare
FMarker.Canvas.Draw(2, 0, UpperMarkerImage);
UpperMarkerImage.Free;
TmpStr := 'X: ' + FormatFloat('0.00',AX) + ' Y: ' + FormatFloat('0.00',AY);
FMarker.Canvas.Textout(18,
end;
if AWhichMarker then
begin
LowerMarkerImage := TBitmap.Create;
LowerMarkerImage.LoadFromR
LowerMarkerImage.Transpare
FMarker.Canvas.Draw(2, 16, LowerMarkerImage);
LowerMarkerImage.Free;
TmpStr := 'X: ' + FormatFloat('0.00',AX) + ' Y: ' + FormatFloat('0.00',AY);
FMarker.Canvas.Textout(18,
end;
XYMarkerImage := TBitmap.Create;
XYMarkerImage.LoadFromReso
XYMarkerImage.Transparent := True;
FMarker.Canvas.Draw(Round(
XYMarkerImage.Free;
GradX := FData[FMarker.DataIdx].Get
GradX := GradX - FData[FMarker.DataIdx].Get
GradY := FData[FMarker.DataIdx].Get
GradY := GradY - FData[FMarker.DataIdx].Get
with FMarker.Canvas do
begin
TmpStr := 'X: '+ FormatFloat('0.00',GradX) + ' Y: ' + FormatFloat('0.00',GradY);
Textout(Round(Width / 2) + 34, 0, TmpStr + ' ');
Textout(Round(Width / 2), 16, 'Name:');
Pen.Width := 5;
Pen.Color := FData[FMarker.DataIdx].Plo
MoveTo(PenPos.X + 4, PenPos.Y + 5);
LineTo(PenPos.X + 24, PenPos.Y);
TextOut(PenPos.X + 4, PenPos.Y - 5, FData[FMarker.DataIdx].Plo
Pen.Width := 1;
end;
end;
{-------------------------
procedure TRtChart.LinGradFit;
var
I, n, LowerIndex, UpperIndex: Integer;
SumX, SumY, SumX2, SumXY, M, C: Single;
NewXMin, NewXMax, XInc: Single;
AlReadyDone: Boolean;
begin
SumX := 0;
SumY := 0;
SumX2 := 0;
SumXY := 0;
AlReadyDone := False;
{ do not redo gradient fit is already done }
for I:= Low(FData) to High(FData) do
if FData[I].PlotName = 'Gradient Fit' then AlReadyDone := True;
if not AlReadyDone and FPopUpItems[ChartMarker].C
begin
if FMarker.Lower.Idx > FMarker.Upper.Idx then
begin
LowerIndex := FMarker.Upper.Idx;
UpperIndex := FMarker.Lower.Idx;
end
else
begin
LowerIndex := FMarker.Lower.Idx;
UpperIndex := FMarker.Upper.Idx;
end;
n := UpperIndex - LowerIndex+1;
for I:= LowerIndex to UpperIndex do
begin
SumX := SumX + FData[FMarker.DataIdx].Get
SumY := SumY + FData[FMarker.DataIdx].Get
SumX2 := SumX2 + Sqr(FData[FMarker.DataIdx]
SumXY := SumXY + FData[FMarker.DataIdx].Get
end;
M := ((SumXY / SumX)-(SumY / n)) / ((SumX2 / SumX) - (SumX / n));
C := (SumY / n) - ((SumX / n) * M);
NewXMin := FData[FMarker.DataIdx].Get
NewXMin := NewXMin / 1.1; { add 10% }
NewXMax := FData[FMarker.DataIdx].Get
NewXMax := NewXMax * 1.1; { add 10% }
XInc := (NewXMax - NewXMin) / n;
AddSeries('Gradient Fit', clWhite, psLines);
While NewXMin < NewXMax do
begin
Add(NewXMin,M * NewXMin + C, FItems - 1);
NewXMin := NewXMin + XInc;
end;
end;
end;
{-------------------------
procedure TRtChart.RemoveLinGradFit;
begin
ReMoveSeries('Gradient Fit');
end;
{-------------------------
procedure TRtChart.AxisChanged(Sende
begin
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.MoveValiDateXY(AD
var
M, C: Single;
begin
if AMoveX < 0 then { calculate new start point if gone over Left axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M*AMoveX);
AMoveX := 0;
AMoveY := (M*AMoveX) + C;
end;
if AMoveX > FPlotArea.Right - FPlotArea.Left then { calculate new start point if gone over right axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveX := FPlotArea.Right - FPlotArea.Left;
AMoveY := (M*AMoveX) + C;
end;
if AMoveY < 0 then { calculate new start point if gone over top axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveY := 0;
{ check for possible divide by zero error }
if M = 0 then AMoveX := (AMoveY - C) else AMoveX := (AMoveY - C) / M;
end;
if AMoveY > FPlotArea.Bottom then { calculate new start point if gone over Bottom axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveY := FPlotArea.Bottom;
{ check for possible divide by zero error }
if M = 0 then AMoveX := (AMoveY - C) else AMoveX := (AMoveY - C) / M;
end;
{ if still out of the limits adjust }
if AMoveX < 0 then AMoveX := 0;
if AMoveX > FPlotArea.Right - FPlotArea.Left then AMoveX := FPlotArea.Right - FPlotArea.Left;
if AMoveY < 0 then AMoveY := 0;
if AMoveY > FPlotArea.Bottom then AMoveY := FPlotArea.Bottom;
end;
{-------------------------
{ if plot has gone over plot area chop it off }
procedure TRtChart.DrawValiDateXY(AM
var
M, C: Single;
begin
if ADrawX < 0 then { calculate new plot if gone over Left axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawX := 0;
ADrawY := (M*ADrawX) + C;
end;
if ADrawX > FPlotArea.Right - FPlotArea.Left then { calculate new plot if gone over right axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawX := FPlotArea.Right - FPlotArea.Left;
ADrawY := (M*ADrawX) + C;
end;
if ADrawY < 0 then { calculate new plot if gone over top axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawY := 0;
ADrawX := (ADrawY-C) / M;
end;
if ADrawY > FPlotArea.Bottom then { calculate new plot if gone over Bottom axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawY := FPlotArea.Bottom;
ADrawX := (ADrawY-C) / M;
end;
{ if still out of the limits adjust }
if ADrawX < 0 then ADrawX := 0;
if ADrawX > FPlotArea.Right - FPlotArea.Left then ADrawX := FPlotArea.Right - FPlotArea.Left;
if ADrawY < 0 then ADrawY := 0;
if ADrawY > FPlotArea.Bottom then ADrawY := FPlotArea.Bottom;
end;
{-------------------------
procedure Register;
begin
RegisterComponents('Servoc
end;
{-------------------------
end.
Here is the forms code DunlopTyreAbsorb.pas
unit DunTyreAbsorb;
interface
{*************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, inifiles,
CalSet, ComCtrls, StdCtrls, ExtCtrls, Menus, ToolWin, RtChart, ChartExt, ImgList,
ThdTimer, plotOpts, Trips;
{*************************
const
cSp = 50;
cLd = 5000;
cTm = 10;
PltClr: array[1..5] of TColor = (clMaroon, clGreen, clOlive, clNavy, clPurple);
cSbAESK = 1;
cSbSide = 2;
cSbStatus = 3;
cSideName: array [1..2] of String = ('LEFT', 'RIGHT');
cLeft = 1;
cRight = 2;
cLoad = 1;
cPos = 2;
cSpeed = 3;
cLoadDAC = 0;
cSpeedDAC = 1;
cDigInSide = 8;
cDigInReady = 9;
cDigInMode = 10;
cDigInTrip1 = 12;
cDigInTrip2 = 13;
cDigInTrip3 = 14;
cDigInTrip4 = 15;
cDigInTrip5 = 16;
cDigInTrip6 = 17;
cDigInTrip7 = 18;
cDigInTrip8 = 19;
cDigOutLoadPos = 0; { 1 = position, 0 = load }
cDigOutDrumStop = 1; { 1 = stop, 0 = clear }
cDigOutCoast = 2; { 1 = Coast mode, 0 = reconnect }
cAoutLoad = 0;
cAoutSpeed = 1;
type
EConfigFileError = class(Exception);
ENoConfigFile = class(Exception);
EHdrFileError = class(Exception);
ENoHdrFile = class(Exception);
EAchieveFileError = class(Exception);
ENoAchieveFile = class(Exception);
EAESKFileError = class(Exception);
ENoAESKFile = class(Exception);
EUserCancel = class(Exception);
ECalFileError = class(Exception);
ECycleLimit = class(Exception);
ETyreInst = class(Exception);
EAcqCardError = class(Exception);
EAcqMemError = class(Exception);
ESystemNotReady = class(Exception);
ENothingToTest = class(Exception);
ETrip = class(Exception);
{*************************
TCfg = record
Name: String;
Status: Integer;
Path: String;
end;
TConfig = array [1..2] of TCfg;
{*************************
TTest = record
Load: Single;
KE: Single;
Required: Integer;
Achieved: Integer;
TNoLoad: Single;
TLoad: Single;
end;
TTestsDone = array [1..2] of array [1..2] of TTest;
{*************************
TKEFLy = record
High: Single;
Low: Single;
end;
{*************************
TfrmTyreAbsorb = class(TForm)
mmMain: TMainMenu;
SB: TStatusBar;
mmiSelect: TMenuItem;
mmiExit: TMenuItem;
NB: TNotebook;
gbLeft: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
pnlLMachTest: TPanel;
pnlLOrderNum: TPanel;
pnlLTyreSize: TPanel;
lvLeft: TListView;
gbRight: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
pnlRMachTest: TPanel;
pnlROrderNum: TPanel;
pnlRTyreSize: TPanel;
lvRight: TListView;
Chart: TRtChart;
IL: TImageList;
mmiFile: TMenuItem;
mmiTyre: TMenuItem;
mmiInstall: TMenuItem;
mmiRemove: TMenuItem;
Tools1: TMenuItem;
ttmrAcqIn: TThreadedTimer;
mmiStop: TMenuItem;
mmiStart: TMenuItem;
tmrStopTest: TTimer;
mmiPlotOptions: TMenuItem;
mmiview: TMenuItem;
mmiSetup: TMenuItem;
mmiChart: TMenuItem;
N1: TMenuItem;
mmiPrint: TMenuItem;
N2: TMenuItem;
mmiNew: TMenuItem;
mmiopen: TMenuItem;
odOpen: TOpenDialog;
sdNew: TSaveDialog;
mmiAbout: TMenuItem;
N4: TMenuItem;
mmiReport: TMenuItem;
CB: TControlBar;
tlbMain: TToolBar;
tbNew: TToolButton;
tbOpen: TToolButton;
tbPrint: TToolButton;
ToolButton4: TToolButton;
tbSetup: TToolButton;
tbChart: TToolButton;
tlbTrips: TToolBar;
tbTrip1: TToolButton;
tbTrip2: TToolButton;
tbTrip3: TToolButton;
tbTrip4: TToolButton;
tbTrip5: TToolButton;
tbTrip6: TToolButton;
tbTrip7: TToolButton;
tbTrip8: TToolButton;
ToolButton1: TToolButton;
tbStop: TToolButton;
mmiTrips: TMenuItem;
mmiHelp: TMenuItem;
pnlMeter: TPanel;
lblTime: TLabel;
lblLoad: TLabel;
lblSpeed: TLabel;
N3: TMenuItem;
mmiResults: TMenuItem;
N5: TMenuItem;
mmiCoast: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mmiStartClick(Sender: TObject);
procedure tbSetupClick(Sender: TObject);
procedure tbChartClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiRemoveClick(Sender: TObject);
procedure mmiInstallClick(Sender: TObject);
procedure ttmrAcqInTimer(Sender: TObject);
procedure mmiStopClick(Sender: TObject);
procedure LVSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
procedure tmrStopTestTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure mmiPlotOptionsClick(Sender
procedure mmiPrintClick(Sender: TObject);
procedure mmiNewClick(Sender: TObject);
procedure mmiopenClick(Sender: TObject);
procedure mmiAboutClick(Sender: TObject);
procedure mmiReportClick(Sender: TObject);
procedure mmiTripsClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure mmiResultsClick(Sender: TObject);
procedure mmiCoastClick(Sender: TObject);
private
FCalib: TCalibSetting;
FErrCode: byte;
FConfig: TConfig;
FWhichSide: byte;
FActiveSide: byte;
FTestsDone: TTestsDone;
FCalData: TChannel;
FStartTestLoad: Single;
TY: array [1..2,1..15] of String;
QY: array [1..2,1..7] of String;
FAcqErr: Integer;
FAcqData: array [0..8] of Double;
FMemHnd: Integer;
FDigOutVal: Word;
FUserStop: Boolean;
FStartTime: TDateTime;
FOldTime: Double;
FStartTest: Boolean;
FfrmPlotOpt: TfrmPlotOpt;
FfrmTrips: TfrmTrips;
FLeftOffset: Single;
FRightOffset: Single;
FSpeedOffset: Single;
FSysNotReadyCntr: Integer;
FKEFLy: TKEFLy;
FTargetTime: Single;
FCoastType: Byte;
FCoasting: Boolean;
function GetSpeed: Single;
function SetSpeed(Speed: Single): Boolean;
function GetLoad: Single;
function SetLoad(Load: Single): Boolean;
function GetPosition: Single;
procedure ReadConfigFile;
procedure SaveConfigFile;
procedure ReadHeader(FileName: String);
procedure SaveHeader(FileName: String);
procedure ReadAchieved(FileName: String);
procedure SaveAchieved(FileName: String);
procedure SetSide(WhichSide: byte);
procedure DisplayHeader(WhichSide: Byte);
procedure DisableSide(WhichSide: byte);
procedure EnableSide(WhichSide: byte);
procedure CommandReset;
procedure CheckDrum(SpeedTarget: Single);
function DoTouchLoad: Single;
procedure TyreStop;
procedure SaveData;
procedure ReadyToStart;
procedure DoError(ErrNo: Integer);
procedure NewTest;
procedure OpenTest;
procedure DisableAll;
procedure EnableAll;
procedure MyHint(Sender: TObject);
procedure ReadTrips;
procedure SaveTrips;
procedure CheckTrips;
end;
{*************************
var
frmTyreAbsorb: TfrmTyreAbsorb;
implementation
uses TouchLoad, SaveTest, TestResult, InstallTyre, Cbw, Status, New, AboutBox, TestReport,
Coast;
{$R *.DFM}
{*************************
procedure TfrmTyreAbsorb.FormCreate(
var
RevLevel: Single;
DigInVal: SmallInt;
begin
LblTime.Caption := 'Time: 0 Secs';
FUserStop := False;
FErrCode := 0;
Chart.XAxis.Min := 0;
Chart.YAxis.Min := 0;
Chart.Y2Axis.min := 0;
FSysNotReadyCntr := 0;
FCoastType := 0;
nb.ActivePage := 'Test';
Application.OnHint := MyHint;
FfrmPlotOpt := TfrmPlotOpt.Create(Self);
FfrmTrips := TfrmTrips.Create(Self);
try
RevLevel := CURRENTREVNUM; { setup AcqCard }
FAcqErr := cbDeclareRevision(RevLevel
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbErrHandling(DONTPRINT, DONTSTOP);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTA, DIGITALOUT);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTB, DIGITALIN);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTCL, DIGITALIN);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FMemHnd := cbWinBufAlloc(800); { allocate 8 channels of data }
if FMemHnd = 0 then raise EAcqMemError.Create('');
FDigOutVal := 0;
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1); { reset digital out}
if FAcqErr <> 0 then raise EAcqCardError.Create('');
CommandReset;
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInSide, DigInVal); { find which side }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then FActiveSide := cLeft else FActiveSide := cRight;
ReadConfigFile;
if FConfig[cLeft].Status > 0 then SetSide(cLeft);
if FConfig[cRight].Status > 0 then SetSide(cRight);
{ read calibration file }
FCalib := TCalibSetting.Create();
if not FCalib.CalibFileExists(0) then raise ECalFileError.Create('')
else FCalData := FCalib.GetData;
DisplayHeader(cLeft);
DisableSide(cLeft);
DisplayHeader(cRight);
DisableSide(cRight);
DisplayHeader(FActiveSide)
ReadTrips;
FStartTest := False;
FCoasting := False;
ttmrAcqIn.Enabled := True;
except
on EConfigFileError do FErrCode := 1;
on ENoConfigFile do FErrCode := 2;
on EHdrFileError do FErrCode := 3;
on ENoHdrFile do FErrCode := 4;
on EAchieveFileError do FErrCode := 5;
on ENoAchieveFile do FErrCode := 6;
on ECalFileError do FErrCode := 7;
on EAcqCardError do FErrCode := 8;
on EAcqMemError do FErrCode := 9;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormDestroy
begin
if FCalib <> nil then FCalib.Free;
if FMemHnd <> 0 then cbWinBufFree(FMemHnd);
FfrmPlotOpt.Free;
FfrmTrips.Free;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormCloseQu
begin
if FStartTest or FCoasting then
CanClose := False else ttmrAcqIn.Enabled := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.SetSide(Whi
begin
FWhichSide := WhichSide;
ReadHeader(FConfig[WhichSi
ReadAchieved(FConfig[Which
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadConfigF
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
FConfig[cLeft].Name := ConfigFile.ReadString('Abs
if FConfig[cLeft].Name = 'ERR' then raise EConfigFileError.Create(''
FConfig[cLeft].Path := ConfigFile.ReadString('Abs
if FConfig[cLeft].Path = 'ERR' then raise EConfigFileError.Create(''
FConfig[cLeft].Status := ConfigFile.ReadInteger('Ab
if FConfig[cLeft].Status = -1 then raise EConfigFileError.Create(''
FConfig[cRight].Name := ConfigFile.ReadString('Abs
if FConfig[cRight].Name = 'ERR' then raise EConfigFileError.Create(''
FConfig[cRight].Path := ConfigFile.ReadString('Abs
if FConfig[cRight].Path = 'ERR' then raise EConfigFileError.Create(''
FConfig[cRight].Status := ConfigFile.ReadInteger('Ab
if FConfig[cRight].Status = -1 then raise EConfigFileError.Create(''
FLeftOffset := ConfigFile.ReadFloat('Load
if FLeftOffset = -1 then raise EConfigFileError.Create(''
FRightOffset := ConfigFile.ReadFloat('Load
if FRightOffset = -1 then raise EConfigFileError.Create(''
FSpeedOffset := ConfigFile.ReadFloat('Spee
if FSpeedOffset = -1 then raise EConfigFileError.Create(''
FKEFly.High := ConfigFile.ReadFloat('Flyw
if FKEFly.High = -1 then raise EConfigFileError.Create(''
FKEFly.Low := ConfigFile.ReadFloat('Flyw
if FKEFly.Low = -1 then raise EConfigFileError.Create(''
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveConfigF
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
ConfigFile.WriteString('Ab
ConfigFile.WriteString('Ab
ConfigFile.WriteInteger('A
ConfigFile.WriteString('Ab
ConfigFile.WriteString('Ab
ConfigFile.WriteInteger('A
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormShow(Se
procedure ShowError(ATitle: String);
begin
MessageDlg(ATitle, mtError, [mbOk], 0);
Close;
end;
begin
case FErrCode of
0:;
1: ShowError('Config File Error');
2: ShowError('No Config File');
3: ShowError('Header File Error');
4: ShowError('No Header File');
5: ShowError('Achieve File Error');
6: ShowError('No Achieve File');
7: ShowError('Main Calibration File Error');
8: ShowError('Acq Error: CODE ' + IntToStr(FAcqErr));
9: ShowError('Unable To Allocate Scan Memory');
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadHeader(
var
TmpStr: String;
HdrFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoHdrFile.Create('');
AssignFile(HdrFile, FileName);
try
try
{ TY stuff }
Reset(HdrFile);
for I := 1 to 15 do
begin
Readln(HdrFile, TmpStr);
Ty[FWhichSide, I] := TmpStr;
end;
{ QY stuff }
for I := 1 to 7 do
begin
Readln(HdrFile, TmpStr);
Qy[FWhichSide, I] := TmpStr;
end;
{ High & Speed params }
for I:= Low(FTestsDone[FWhichSide]
begin
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].Load := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].KE := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].Required := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].TNoLoad := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].TLoad := StrToInt(TmpStr);
end;
except
on Exception do raise EHdrFileError.Create('');
end;
finally
CloseFile(HdrFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveHeader(
var
HdrFile: TextFile;
I, WS: Integer;
begin
if not FileExists(FileName) then raise ENoHdrFile.Create('');
AssignFile(HdrFile, FileName);
try
try
WS := FWhichSide;
Rewrite(HdrFile);
for I := Low(Ty[WS]) to High(Ty[WS]) do Writeln(HdrFile, Ty[WS, I]);
for I := Low(Qy[WS]) to High(Qy[WS]) do Writeln(HdrFile, Qy[WS, I]);
for I:= Low(FTestsDone[WS]) to High(FTestsDone[WS]) do
begin
Writeln(HdrFile, Round(FTestsDone[WS, I].Load));
Writeln(HdrFile, Round(FTestsDone[WS, I].KE));
Writeln(HdrFile, Round(FTestsDone[WS, I].Required));
Writeln(HdrFile, Round(FTestsDone[WS, I].TNoLoad));
Writeln(HdrFile, Round(FTestsDone[WS, I].TLoad));
end;
except
on Exception do raise EHdrFileError.Create('');
end;
finally
CloseFile(HdrFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadAchieve
var
TmpStr: String;
AchFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoAchieveFile.Create('');
AssignFile(AchFile, FileName);
try
try
Reset(AchFile);
for I:= Low(FTestsDone[FWhichSide]
begin
Readln(AchFile, TmpStr);
FTestsDone[FWhichSide, I].Achieved := StrToInt(TmpStr);
end;
except
on Exception do raise EAchieveFileError.Create('
end;
finally
CloseFile(AchFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveAchieve
var
AchFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoAchieveFile.Create('');
AssignFile(AchFile, FileName);
try
try
ReWrite(AchFile);
{ first line is the number of AESK's }
for I:= Low(FTestsDone[FWhichSide]
Writeln(AchFile, IntToStr(FTestsDone[FWhich
except
on Exception do raise EAchieveFileError.Create('
end;
finally
CloseFile(AchFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.DisplayHead
var
ListItem: TListItem;
ListView: TListView;
MachTest, OrderNum, TyreSize: TPanel;
CalSettings: TSettings;
begin
if FConfig[WhichSide].Status = 0 then DisableSide(WhichSide) else EnableSide(WhichSide);
{ get right scale and offset for the selected side }
if FActiveSide = WhichSide then
begin
sb.Panels.Items[cSbSide].T
CalSettings := FCalib.GetSettings;
CalSettings.Machine := WhichSide;
FCalib.SetSettings(CalSett
FCalData := FCalib.GetData;
end;
if WhichSide = cLeft then
begin
MachTest := pnlLMachTest;
OrderNum := pnlLOrderNum;
TyreSize := pnlLTyreSize;
ListView := lvLeft;
end
else begin
MachTest := pnlRMachTest;
OrderNum := pnlROrderNum;
TyreSize := pnlRTyreSize;
ListView := lvRight;
end;
MachTest.Caption := ' ' + TY[WhichSide, 2];
OrderNum.Caption := ' ' + TY[WhichSide, 4];
TyreSize.Caption := ' ' + TY[WhichSide, 6];
ListView.Items.Clear;
ListItem := ListView.Items.Add;
ListItem.Caption := 'High Speed';
ListItem.SubItems.Add(IntT
ListItem.SubItems.Add(IntT
ListItem := ListView.Items.Add;
ListItem.Caption := 'Low Speed';
ListItem.SubItems.Add(IntT
ListItem.SubItems.Add(IntT
end;
{-------------------------
procedure TfrmTyreAbsorb.DisableSide
var
I: Integer;
begin
case WhichSide of
cLeft: for I := 0 to gbLeft.ControlCount - 1 do gbLeft.Controls[I].Enabled
cRight: for I := 0 to gbRight.ControlCount - 1 do gbRight.Controls[I].Enable
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.EnableSide(
var
I: Integer;
begin
case WhichSide of
cLeft: for I := 0 to gbLeft.ControlCount - 1 do gbLeft.Controls[I].Enabled
cRight: for I := 0 to gbRight.ControlCount - 1 do gbRight.Controls[I].Enable
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiStartCli
var
Load, Speed: Single;
I: Integer;
LV: TListView;
TestName: String;
begin
SB.Panels.Items[cSbStatus]
FSysNotReadyCntr := 0;
ttmrAcqIn.Enabled := True;
try
CheckTrips;
if FActiveSide = 1 then LV := lvLeft else LV := lvRight;
if LV.Selected = nil then raise ENothingToTest.Create('');
if LV.Selected.SubItems.Strin
raise ECycleLimit.Create('');
TestName := LV.Selected.Caption;
DisableAll;
Chart.ClearAll;
tbChart.Down := True;
mmiChart.Checked := True;
mmiSetup.Checked := False;
NB.ActivePage := 'Chart';
ReadyToStart;
CommandReset;
if TestName = 'High Speed' then Speed := 120 else Speed := 90;
// if TestName = 'High Speed' then Speed := 0 else Speed := 0;
CheckDrum(Speed);
{ ramp to start load }
if FCoastType < 2 then { 2 being without load }
begin
Load := DoTouchLoad;
if TestName = 'High Speed' then I := 1 else I := 2;
while Load < FTestsDone[FActiveSide, I].Load do
begin
if not SetLoad(Load) then raise EAcqCardError.Create('');
if not SetSpeed(Speed) then raise EAcqCardError.Create('');
Load := Load + 0.1;
end;
end;
Sleep(2000);
{ coast mode }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FStartTime := Now;
FOldTime := 0.01;
if FCoastType = 0 then FStartTest := True else FCoasting := True;
except
on EUserCancel do DoError(1);
on EAcqCardError do DoError(2);
on EConfigFileError do DoError(3);
on ENoConfigFile do DoError(4);
on ECycleLimit do DoError(5);
on ENothingToTest do DoError(6);
on ETrip do MessageDlg('Can not start test on critical trip', mtError, [mbOk], 0);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.tbSetupClic
begin
nb.ActivePage := 'Test';
tbSetup.Down := True;
mmiSetup.Checked := True;
mmiChart.Checked := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.tbChartClic
begin
nb.ActivePage := 'Chart';
tbChart.Down := True;
mmiSetup.Checked := False;
mmiChart.Checked := True;
end;
{-------------------------
procedure TfrmTyreAbsorb.CommandRese
begin
{ Coast mode }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Sleep(100);
{ position control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
{ drum stop }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
{ reset DAC's }
FAcqErr := cbAOut(0, cSpeedDAC, BIP10VOLTS, $7FFF); { 0 Volts }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, $7FFF); { 0 Volts }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
end;
{-------------------------
procedure TfrmTyreAbsorb.CheckDrum(S
var
Speed: Single;
begin
if GetSpeed < 4.2 then SB.Panels.Items[cSbStatus]
if not SetSpeed(5) then raise EAcqCardError.Create('');
repeat
Speed := GetSpeed;
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed > 3;
if not SetSpeed(SpeedTarget) then raise EAcqCardError.Create('');
repeat
Speed := GetSpeed;
SB.Panels.Items[cSbStatus]
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed > SpeedTarget - 2;
SB.Panels.Items[cSbStatus]
end;
{-------------------------
function TfrmTyreAbsorb.GetSpeed: Single;
var
ADCValue: Double;
Scale, Offset: Double;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[3];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cSpeed].Scal
Offset := FCalData.Chan[cSpeed].Offs
Result := ADCValue * Scale + Offset;
end;
{-------------------------
function TfrmTyreAbsorb.SetSpeed(Sp
var
AoutSpeed: Word;
MaxSpeed, Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
Result := False;
Speed := Speed + FSpeedOffset;
if Speed > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
Scale := FCalData.Chan[cSpeed].Scal
Offset := FCalData.Chan[cSpeed].Offs
MaxSpeed := $7FFF * Scale + Offset;
if Speed >= 0 then AoutSpeed := Round(($7FFF/ MaxSpeed) * Speed) + $7FFF
else AoutSpeed := Round(($7FFF/ MaxSpeed) * Speed);
FAcqErr := cbAOut(0, cAoutSpeed, BIP10VOLTS, AoutSpeed); { Ouput SpeedTarget on DAC }
if FAcqErr <> 0 then exit;
Result := True;
end;
{-------------------------
function TfrmTyreAbsorb.DoTouchLoad
var
DispMoveMax, Load, LoadPeak, Position, CurTime, TouchLoad: Single;
Rate, Command, I: Integer;
frmTouchLoad: TfrmTouchLoad;
Time: TDateTime;
Hour, Min, Sec, MSec: Word;
FileName: String;
ConfigFile: TIniFile;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
DispMoveMax := ConfigFile.ReadInteger('To
if DispMoveMax < 0 then raise EConfigFileError.Create(''
TouchLoad := ConfigFile.ReadInteger('To
if TouchLoad < 0 then raise EConfigFileError.Create(''
Rate := ConfigFile.ReadInteger('To
if Rate < 0 then raise EConfigFileError.Create(''
ConfigFile.Free;
LoadPeak := 0;
frmTouchLoad := TfrmTouchLoad.Create(Self)
try
frmTouchLoad.Show;
Command := Rate;
Time := Now;
{ in position control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
repeat // start Actuator moving
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, Command);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Load := GetLoad;
frmTouchLoad.lblLoadValue.
FCalData.Chan[cLoad].Units
if Load > LoadPeak then LoadPeak := Load;
Position := GetPosition;
frmTouchLoad.lblPositionVa
FCalData.Chan[cPos].Units;
Inc(Command);
DecodeTime(Now - Time, Hour, Min, Sec, MSec);
CurTime := (Hour * 60 * 60) * (Min * 60) + Sec + (MSec /1000);
frmTouchLoad.lblTimeValue.
for I := 1 to 5000 do
begin
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
if frmTouchLoad.ModalResult = mrCancel then raise EUserCancel.Create('');
end;
until Position > DispMoveMax;
TouchLoad := LoadPeak + TouchLoad;
repeat // move actuator until touch load seen
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, Command);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Load := GetLoad;
frmTouchLoad.lblLoadValue.
FCalData.Chan[cLoad].Units
Position := GetPosition;
frmTouchLoad.lblPositionVa
FCalData.Chan[cPos].Units;
Inc(Command);
DecodeTime(Now - Time, Hour, Min, Sec, MSec);
CurTime := (Hour * 60 * 60) * (Min * 60) + Sec + (MSec /1000);
frmTouchLoad.lblTimeValue.
for I := 1 to 5000 do
begin
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
if frmTouchLoad.ModalResult = mrCancel then raise EUserCancel.Create('');
end;
until Load > TouchLoad;
TouchLoad := Load;
if not SetLoad(TouchLoad) then EAcqCardError.Create('');
{ in load control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
finally
frmTouchLoad.Free;
Result := TouchLoad;
end;
end;
{-------------------------
function TfrmTyreAbsorb.GetLoad: Single;
var
ADCValue: Double;
Scale, Offset: Double;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[1];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cLoad].Scale
Offset := FCalData.Chan[cLoad].Offse
Result := ADCValue * Scale + Offset;
end;
{-------------------------
function TfrmTyreAbsorb.SetLoad(Loa
var
AoutLoad: Word;
MaxLoad, Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
Result := False;
if FActiveSide = cLeft then Load := Load + FLeftOffset
else Load := Load + FRightOffset;
if Load > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
Scale := FCalData.Chan[cLoad].Scale
Offset := FCalData.Chan[cLoad].Offse
MaxLoad := $7FFF * Scale + Offset;
if Load >= 0 then AoutLoad := Round(($7FFF/ MaxLoad) * Load) + $7FFF
else AoutLoad := Round(($7FFF/ MaxLoad) * Load);
FAcqErr := cbAOut(0, cAoutLoad, BIP10VOLTS, AoutLoad); { Ouput LoadTarget on DAC }
if FAcqErr <> 0 then exit;
Result := True;
end;
{-------------------------
function TfrmTyreAbsorb.GetPosition
var
ADCValue: Double;
Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[2];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cPos].Scale[
Offset := FCalData.Chan[cPos].Offset
Result := ADCValue * Scale + Offset;
end;
{-------------------------
procedure TfrmTyreAbsorb.TyreStop;
var
Speed, AvgSpeed: Single;
Cntr, TimeStart: DWORD;
begin
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Sleep(100);
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 1);
if FAcqErr <> 0 then EAcqCardError.Create('');
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
if not SetLoad(FStartTestLoad) then EAcqCardError.Create('');
if not SetSpeed(0) then EAcqCardError.Create('');
repeat
TimeStart := GetTickCount + 1000;
Cntr := 0;
AvgSpeed := 0;
repeat
AvgSpeed := AvgSpeed + GetSpeed;
Inc(Cntr);
until GetTickCount > TimeStart;
Speed := AvgSpeed / Cntr;
SB.Panels.Items[cSbStatus]
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed < 3;
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveData;
var
frmSaveTemp: TfrmSaveTemp;
Dir, FileName: String;
I: Integer;
DatFile: TIniFile;
begin
frmSaveTemp := TfrmSaveTemp.Create(Self);
try
if frmSaveTemp.ShowModal = mrYes then
begin
Dir := 'Err';
if SB.Panels[cSBAESK].Text = '' then
begin
MessageDlg('Can not save data', mtError, [mbOk], 0);
Exit;
end;
if SB.Panels[cSBAESK].Text = 'Low Speed' then I := 2 else I := 1;
Dir := FConfig[FActiveSide].Path + SB.Panels[cSBAESK].Text + '-';
Inc(FTestsDone[FActiveSide
SaveAchieved(FConfig[FActi
DisplayHeader(FActiveSide)
Dir := Dir + IntToStr(FTestsDone[FActiv
Exit;
if Dir = 'Err' then raise Exception.Create('Error creating result directory');
if not CreateDir(Dir) then raise Exception.Create('Error creating result directory');
FileName := Dir + '\' + ExtractFileName(Dir) + '.abs';
DatFile := TIniFile.Create(FileName);
DatFile.WriteDate('Test', 'Date', Now);
DatFile.WriteTime('Test', 'Time', Now);
DatFile.WriteString('Test'
for I := 0 to frmSaveTemp.memComments.Li
DatFile.WriteString('Test'
frmSaveTemp.memComments.Li
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.Free;
end;
finally
frmSaveTemp.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiExitClic
begin
Close;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiRemoveCl
const
cNoTyre = 'No tyre to remove';
var
DocFile: TiniFile;
FileName: String;
ListView: TListView;
MachTest, OrderNum, TyreSize: TPanel;
frmTestResult: TfrmTestResult;
begin
if FConfig[FActiveSide].Statu
else begin
FileName := FConfig[FActiveSide].Path + FConfig[FActiveSide].Name + '.ARS';
DocFile := TiniFile.Create(FileName);
frmTestResult := TfrmTestResult.Create(Self
if frmTestResult.ShowModal = mrOk then
begin
DocFile.WriteString('Test'
DocFile.WriteString('Date'
frmTestResult.Free;
DocFile.Free;
FConfig[FActiveSide].Statu
SaveConfigFile;
DisableSide(FActiveSide);
if FActiveSide = cLeft then
begin
MachTest := pnlLMachTest;
OrderNum := pnlLOrderNum;
TyreSize := pnlLTyreSize;
ListView := lvLeft;
end
else begin
MachTest := pnlRMachTest;
OrderNum := pnlROrderNum;
TyreSize := pnlRTyreSize;
ListView := lvRight;
end;
MachTest.Caption := '';
OrderNum.Caption := '';
TyreSize.Caption := '';
ListView.Items.Clear;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiInstallC
const
cTyreInst = 'Tyre already installed';
cNoHdr = 'No Header File';
cHdrErr = 'Header File Error';
cAchErr = 'Achieve File Error';
cNoAch = 'No Achieve File';
cCfgErr = 'Saving config file error';
var
frmInstallTyre: TfrmInstallTyre;
begin
try
if FConfig[FActiveSide].Statu
odOpen.Title := 'Install Tyre';
if odOpen.Execute then
begin
FWhichSide := FActiveSide;
ReadHeader(odOpen.FileName
ReadAchieved(ChangeFileExt
Ty[1, 7] := 'HS3';
Ty[2, 7] := 'HS4';
frmInstallTyre := TfrmInstallTyre.CreateWith
try
if frmInstallTyre.ShowModal = mrOk then
begin
FConfig[FWhichSide].Path := ExtractFilePath(odOpen.Fil
ChangeFileExt(odOpen.FileN
FConfig[FWhichSide].Name := ChangeFileExt(ExtractFileN
FConfig[FWhichSide].Status
SaveConfigFile;
DisplayHeader(FWhichSide);
SaveHeader(odOpen.FileName
SaveAchieved(ChangeFileExt
end;
finally
frmInstallTyre.Free;
end;
end;
except
on ETyreInst do MessageDlg(cTyreInst, mtError, [mbOk], 0);
on EHdrFileError do MessageDlg(cHdrErr, mtError, [mbOk], 0);
on ENoHdrFile do MessageDlg(cNoHdr, mtError, [mbOk], 0);
on EAchieveFileError do MessageDlg(cAchErr, mtError, [mbOk], 0);
on ENoAchieveFile do MessageDlg(cNoHdr, mtError, [mbOk], 0);
on EConfigFileError do begin
MessageDlg(cCfgErr, mtError, [mbOk], 0);
FConfig[FWhichSide].Status
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadyToStar
var
frmStatus: TfrmStatus;
begin
frmStatus := TfrmStatus.Create(Self);
try
if frmStatus.ShowModal = mrCancel then raise EUserCancel.Create('');
if frmStatus.GetAcqErr <> 0 then
begin
FAcqErr := frmStatus.GetAcqErr;
raise EAcqCardError.Create('');
end;
finally
frmStatus.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ttmrAcqInTi
var
Rate: Longint;
ADData: array [1..800] of Word;
I, J: Integer;
Hour, Min, Sec, MSec: Word;
NowTime: Single;
DigInVal: SmallInt;
AValue: Single;
begin
Rate := 10000;
try
{ cbAInScan(BoardNum, LowChan, HighChan, Count, Rate, Gain, MemHandle, Options) }
FAcqErr := cbAInScan (0, 0, 7, 800, Rate, BIP10VOLTS, FMemHnd, CONVERTDATA);
if FAcqErr <> 0 then exit;
{ cbWinBufToArray(MemHandle,
FAcqErr := cbWinBufToArray(FMemHnd, ADData[1], 0, 800);
if FAcqErr <> 0 then exit;
FAcqData[0] := Now;
for I := 1 to 8 do FAcqData[I] := 0;
for I := 0 to 99 do
begin
for J := 1 to 8 do FAcqData[J] := FAcqData[J] + ADData[(8 * I) + J];
end;
for I := 1 to 8 do FAcqData[I] := (FAcqData[I] / 100) - $7FFF;
CheckTrips;
{ update meters }
lblLoad.Caption := 'Load: ' + FormatFloat('0', GetLoad) + ' ' + FCalData.Chan[1].Units;
lblSpeed.Caption := 'Speed: ' + FormatFloat('0', GetSpeed) + ' ' + FCalData.Chan[3].Units;
{ see if test has started }
if FStartTest then
begin
{ check for emergency/user stop, if so stop test }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInReady, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then Inc(FSysNotReadyCntr) else FSysNotReadyCntr := 0;
if FSysNotReadyCntr > 4 then raise ESystemNotReady.Create('')
if FUserStop then raise EUserCancel.Create('');
DecodeTime(FAcqData[0] - FStartTime, Hour, Min, Sec, MSec);
NowTime := (Hour * 60 * 60) + (Min * 60) + Sec + (MSec / 1000);
if NowTime > FTargetTime then TmrStopTest.Enabled := True
else begin
{ add data to chart}
if NowTime > FOldTime then
begin
{ update meters }
lblTime.Caption := 'Time: ' + FormatFloat('#', NowTime) + ' Secs ';
Chart.Add(0, NowTime, 0);
Chart.Add(NowTime, GetLoad, 1);
Chart.Add(NowTime, GetPosition, 2);
Chart.Add(NowTime, GetSpeed, 3);
with FCalData do
begin
for I := 4 to High(Chan) do
begin
if Chan[I].Name <> '' then { must be calibrated }
begin
if FAcqData[I] > 0 then
AValue := FAcqData[I] * Chan[I].Scale[1] + Chan[I].Offset[1]
else AValue := FAcqData[I] * Chan[I].Scale[1] + Chan[I].Offset[1] * -1;
Chart.Add(NowTime, AValue, I);
end;
end;
end;
end;
FOldTime := NowTime;
end;
end; { if FStartTest then }
if FCoasting then
begin
{ check for emergency/user stop, if so stop test }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInReady, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then Inc(FSysNotReadyCntr) else FSysNotReadyCntr := 0;
if FSysNotReadyCntr > 4 then raise ESystemNotReady.Create('')
if FUserStop then raise EUserCancel.Create('');
DecodeTime(FAcqData[0] - FStartTime, Hour, Min, Sec, MSec);
NowTime := (Hour * 60 * 60) + (Min * 60) + Sec + (MSec / 1000);
lblTime.Caption := 'Time: ' + FormatFloat('#', NowTime) + ' Secs ';
if SB.Panels[cSBAESK].Text = 'High Speed' then
if GetSpeed < 90 then tmrStopTest.Enabled := True;
if SB.Panels[cSBAESK].Text = 'Low Speed' then
if GetSpeed < 3 then tmrStopTest.Enabled := True;
end; { if FCoastType > 0 then }
{ if not testing check if side is different then update }
if not FStartTest or not FCoasting then
begin
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInSide, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then DigInVal := cLeft else DigInVal := cRight;
if DigInVal <> FActiveSide then
begin
DisableSide(FActiveSide);
FActiveSide := DigInVal;
DisplayHeader(FActiveSide)
end;
end;
except
on EAcqCardError do ttmrAcqIn.Enabled := False;
on EUserCancel do begin
SB.Panels.Items[cSbStatus]
ttmrAcqIn.Enabled := False;
FStartTest := False;
FCoastType := 0;
FCoasting := False;
CommandReset;
FUserStop := False;
EnableAll;
end;
on ESystemNotReady do begin
SB.Panels.Items[cSbStatus]
ttmrAcqIn.Enabled := False;
CommandReset;
FUserStop := False;
FStartTest := False;
FCoasting := False;
FCoastType := 0;
EnableAll;
FSysNotReadyCntr := 0;
end;
on ETrip do begin
FStartTest := False;
FCoasting := False;
CommandReset;
FUserStop := False;
FCoastType := 0;
EnableAll;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiStopClic
begin
FUserStop := True;
end;
{-------------------------
procedure TfrmTyreAbsorb.LVSelectIte
const
cNoTyre = 'No Tyre Installed';
var
MaxTime, MaxLoad, MaxSpeed, MaxPos, Max, aaa, bbb, ccc, ddd: Single;
I, J: Integer;
begin
if not Selected then exit;
sb.Panels.Items[cSbAESK].T
FWhichSide := FActiveSide;
if FConfig[FWhichSide].Status
try
Chart.ReMoveAll;
if Item.Caption = 'High Speed' then
begin
MaxLoad := (Round(FTestsDone[FActiveS
MaxSpeed := 150;
ccc := FKEFly.High - FKEFly.Low;
ddd := FTestsDone[FActiveSide, 2].TLoad - FTestsDone[FActiveSide, 1].TLoad;
if ddd = 0 then aaa := ccc else aaa := ccc / ddd;
ddd := FTestsDone[FActiveSide, 2].TNoLoad - FTestsDone[FActiveSide, 1].TNoLoad;
if ddd = 0 then bbb := ccc else bbb := ccc / ddd;
if (aaa - bbb) = 0 then FTargetTime := FTestsDone[FActiveSide, 1].KE
else FTargetTime := FTestsDone[FActiveSide, 1].KE / (aaa - bbb);
end
else begin
MaxLoad := (Round(FTestsDone[FActiveS
MaxSpeed := 100;
aaa := FKEFly.Low / FTestsDone[FActiveSide, 2].TLoad;
bbb := FKEFly.Low / FTestsDone[FActiveSide, 2].TNoLoad;
if (aaa - bbb) = 0 then FTargetTime := FTestsDone[FActiveSide, 2].KE
else FTargetTime := FTestsDone[FActiveSide, 2].KE / (aaa - bbb);
end;
MaxTime := (Round(FTargetTime / 10) + 1) * 10;
{ set chart up for Time }
Chart.AddSeries('Time', clYellow, psLines);
Chart.SetLimits(0, MaxTime, 0, 0, 1, 1, 0);
Chart.Items[0].Show := False;
{ set chart up for Load }
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxLoad, 1, 1, cLoad);
Chart.Items[cLoad].Show := FfrmPlotOpt.cbPlot1.Checke
{ set chart up for Position }
MaxPos := $7FFF * FCalData.Chan[cPos].Scale[
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxPos, 1, 1, cPos);
Chart.Items[cPos].Show := FfrmPlotOpt.cbPlot2.Checke
{ set chart up for Speed }
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxSpeed, 1, 1, cSpeed);
Chart.Items[cSpeed].Show := FfrmPlotOpt.cbPlot3.Checke
{ rest of calibrated channels }
for I := 4 to High(FCalData.Chan) do
begin
if FCalData.Chan[I].Name <> '' then { must be calibrated }
begin
Chart.AddSeries(FCalData.C
Max := $7FFF * FCalData.Chan[I].Scale[1] + FCalData.Chan[I].Offset[1]
Chart.SetLimits(0, MaxTime, 0, Max, 1, 1, I);
for J := 0 to FfrmPlotOpt.ControlCount - 1 do
if FfrmPlotOpt.Controls[J].Na
Chart.Items[I].Show := TCheckBox(FfrmPlotOpt.Cont
end;
end;
{ setup ratios for Yaxis default }
for I := 1 to Chart.Count - 1 do
begin
case I of
cLoad, cSpeed: Max := MaxLoad;
else
Max := $7FFF * FCalData.Chan[1].Scale[1] + FCalData.Chan[I].Offset[1]
end;
Chart.Items[I].YScale := Max / Chart.Items[I].YMax;
end;
Chart.XAxis.Title := 'Time';
Chart.XAxis.Min := 0;
Chart.XAxis.Max := MaxTime;
Chart.YAxis.Title := FCalData.Chan[1].Name;
Chart.YAxis.Min := 0;
Chart.YAxis.Max := Chart.Items[1].YMax;
Chart.YAxis.Font.Color := Chart.Items[1].PlotColor;
Chart.Y2Axis.Title := FCalData.Chan[3].Name;
Chart.Y2Axis.Min := 0;
Chart.Y2Axis.Max := Chart.Items[3].YMax;
Chart.Y2Axis.Font.Color := Chart.Items[3].PlotColor;
except
on EAESKFileError do MessageDlg('Error Reading AESK File!', mtError, [mbOk], 0);
on ENoAESKFile do MessageDlg('No AESK File!', mtError, [mbOk], 0);
on ETyreInst do MessageDlg(cNoTyre, mtWarning, [mbOk], 0);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.tmrStopTest
begin
FStartTest := False;
FCoasting := False;
SB.Panels.Items[cSbStatus]
tmrStopTest.Enabled := False;
try
TyreStop;
CommandReset;
if FCoastType = 0 then
begin
if MessageDlg('Save Data?', mtConfirmation, [mbYes,MbNo], 0) = mrYes then SaveData;
end
else begin
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
MessageDlg(lblTime.Caption
end;
lblTime.Caption := 'Time: 0 Secs';
SB.Panels.Items[cSbStatus]
tbSetup.Down := True;
mmiSetup.Checked := True;
mmiChart.Checked := False;
NB.ActivePage := 'Test';
EnableAll;
except
on EUserCancel do DoError(1);
on EAcqCardError do DoError(2);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiPlotOpti
var
I, J: Integer;
begin
if FConfig[FActiveSide].Statu
begin
MessageDlg('No tyre installed', mtError, [mbOK] ,0);
Abort;
end;
for I := 0 to FfrmPlotOpt.ControlCount - 1 do
if FfrmPlotOpt.Controls[I].Ta
for I := Low(FCalData.Chan) to High(FCalData.Chan) do
begin
if FCalData.Chan[I].Name = '' then break;
for J := 0 to FfrmPlotOpt.ControlCount - 1 do
begin
if FfrmPlotOpt.Controls[J].Na
begin
TLabel(FfrmPlotOpt.Control
FfrmPlotOpt.Controls[J].En
end;
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
end;
end;
FfrmPlotOpt.ShowModal;
if FActiveSide = cLeft then LVSelectItem(Sender, LVLeft.Selected, True)
else LVSelectItem(Sender, LVRight.Selected, True);
end;
{-------------------------
procedure TfrmTyreAbsorb.DoError(Err
begin
case ErrNo of
1: SB.Panels.Items[cSbStatus]
2: SB.Panels.Items[cSbStatus]
3: SB.Panels.Items[cSbStatus]
4: SB.Panels.Items[cSbStatus]
5: SB.Panels.Items[cSbStatus]
6: SB.Panels.Items[cSbStatus]
7: SB.Panels.Items[cSbStatus]
8: SB.Panels.Items[cSbStatus]
end;
CommandReset;
EnableAll;
FUserStop := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiPrintCli
begin
Chart.Print;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiNewClick
begin
if sdNew.Execute then
begin
if UpperCase(ExtractFileExt(s
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.NewTest;
var
frmNewTest: TfrmNewTest;
FileName: String;
NewHdr, NewNum: TextFile;
DocFile: TIniFile;
begin
if FileExists(sdNew.FileName)
begin
MessageDlg('Tyre already defined!', mtError, [mbOk], 0);
exit;
end;
frmNewTest := TfrmNewTest.CreateWithPara
try
frmNewTest.Caption := 'New - ' + ExtractFileName(sdNew.File
if frmNewTest.ShowModal = mrOk then
begin
AssignFile(NewHdr, sdNew.FileName);
ReWrite(NewHdr);
{ TY stuff }
Writeln(NewHdr, ExtractFileName(ChangeFile
Writeln(NewHdr, frmNewTest.edtMachTest.Tex
Writeln(NewHdr, frmNewTest.edtRptNo.Text);
Writeln(NewHdr, frmNewTest.edtOrdNo.Text);
Writeln(NewHdr, frmNewTest.edtWhlNo.Text);
Writeln(NewHdr, frmNewTest.edtSize.Text);
Writeln(NewHdr, frmNewTest.edtTstStat.Text
Writeln(NewHdr, frmNewTest.edtCode.Text);
Writeln(NewHdr, frmNewTest.edtSpacer.Text)
Writeln(NewHdr, frmNewTest.edtSerNo.Text);
Writeln(NewHdr, frmNewTest.edtBearNo.Text)
Writeln(NewHdr, frmNewTest.edtWgt.Text);
Writeln(NewHdr, frmNewTest.edtShaftNo.Text
Writeln(NewHdr, frmNewTest.edtHard.Text);
Writeln(NewHdr, frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
Writeln(NewHdr, frmNewTest.edtTyreSize.Tex
Writeln(NewHdr, frmNewTest.edtTyrePur.Text
Writeln(NewHdr, frmNewTest.edtAirTyp.Text)
Writeln(NewHdr, frmNewTest.edtBasOn.Text);
Writeln(NewHdr, frmNewTest.edtRatLoad.Text
Writeln(NewHdr, frmNewTest.edtRatPress.Tex
Writeln(NewHdr, frmNewTest.edtFlyDia.Text)
{ Test Files }
Writeln(NewHdr, frmNewTest.edtHighLoad.Tex
Writeln(NewHdr, frmNewTest.edtHighKE.Text)
Writeln(NewHdr, frmNewTest.edtHighReq.Text
Writeln(NewHdr, frmNewTest.edtHighTNoLoad.
Writeln(NewHdr, frmNewTest.edtHighTLoad.Te
Writeln(NewHdr, frmNewTest.edtLowLoad.Text
Writeln(NewHdr, frmNewTest.edtLowKE.Text);
Writeln(NewHdr, frmNewTest.edtLowReq.Text)
Writeln(NewHdr, frmNewTest.edtLowTNoLoad.T
Writeln(NewHdr, frmNewTest.edtLowTLoad.Tex
CloseFile(NewHdr);
FileName := ChangeFileExt(sdNew.FileNa
if FileExists(FileName) then exit;
{ cycles achieved }
AssignFile(NewNum, FileName);
ReWrite(NewNum);
Writeln(NewNum, '0');
Writeln(NewNum, '0');
CloseFile(NewNum);
{ write start date }
FileName := ChangeFileExt(sdNew.FileNa
DocFile := TiniFile.Create(FileName);
DocFile.WriteString('Date'
DocFile.Free;
end;
finally
frmNewTest.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiopenClic
begin
OdOpen.Title := 'Open';
if odOpen.Execute then
begin
if UpperCase(ExtractFileExt(o
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.OpenTest;
var
frmNewTest: TfrmNewTest;
TmpStr, FileName: String;
OpenHdr, AchFile: TextFile;
begin
frmNewTest := TfrmNewTest.CreateWithPara
try
AssignFile(OpenHdr, odOpen.FileName);
ReSet(OpenHdr);
{ TY stuff }
ReadLn(OpenHdr, TmpStr);
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtMachTest.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRptNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtOrdNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtWhlNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSize.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTstStat.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtCode.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSpacer.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSerNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtBearNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtWgt.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtShaftNo.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtHard.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTyreSize.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTyrePur.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtAirTyp.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtBasOn.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRatLoad.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRatPress.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtFlyDia.Text := TmpStr;
{ Test stuff }
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighLoad.Tex
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighKE.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighReq.Text
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighTNoLoad.
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighTLoad.Te
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowLoad.Text
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowKE.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowReq.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowTNoLoad.T
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowTLoad.Tex
CloseFile(OpenHdr);
{ read acheived so far }
FileName := ChangeFileExt(odOpen.FileN
AssignFile(AchFile, FileName);
Reset(AchFile);
Readln(AchFile, TmpStr);
frmNewTest.edtHighAch.Text
Readln(AchFile, TmpStr);
frmNewTest.edtLowAch.Text := TmpStr;
CloseFile(AchFile);
frmNewTest.Caption := 'Open - ' + ExtractFileName(odOpen.Fil
if frmNewTest.ShowModal = mrOk then
begin
AssignFile(OpenHdr, odOpen.FileName);
ReWrite(OpenHdr);
{ TY stuff }
Writeln(OpenHdr, ExtractFileName(ChangeFile
Writeln(OpenHdr, frmNewTest.edtMachTest.Tex
Writeln(OpenHdr, frmNewTest.edtRptNo.Text);
Writeln(OpenHdr, frmNewTest.edtOrdNo.Text);
Writeln(OpenHdr, frmNewTest.edtWhlNo.Text);
Writeln(OpenHdr, frmNewTest.edtSize.Text);
Writeln(OpenHdr, frmNewTest.edtTstStat.Text
Writeln(OpenHdr, frmNewTest.edtCode.Text);
Writeln(OpenHdr, frmNewTest.edtSpacer.Text)
Writeln(OpenHdr, frmNewTest.edtSerNo.Text);
Writeln(OpenHdr, frmNewTest.edtBearNo.Text)
Writeln(OpenHdr, frmNewTest.edtWgt.Text);
Writeln(OpenHdr, frmNewTest.edtShaftNo.Text
Writeln(OpenHdr, frmNewTest.edtHard.Text);
Writeln(OpenHdr, frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
Writeln(OpenHdr, frmNewTest.edtTyreSize.Tex
Writeln(OpenHdr, frmNewTest.edtTyrePur.Text
Writeln(OpenHdr, frmNewTest.edtAirTyp.Text)
Writeln(OpenHdr, frmNewTest.edtBasOn.Text);
Writeln(OpenHdr, frmNewTest.edtRatLoad.Text
Writeln(OpenHdr, frmNewTest.edtRatPress.Tex
Writeln(OpenHdr, frmNewTest.edtFlyDia.Text)
{ Test Files }
Writeln(OpenHdr, frmNewTest.edtHighLoad.Tex
Writeln(OpenHdr, frmNewTest.edtHighKE.Text)
Writeln(OpenHdr, frmNewTest.edtHighReq.Text
Writeln(OpenHdr, frmNewTest.edtHighTNoLoad.
Writeln(OpenHdr, frmNewTest.edtHighTLoad.Te
Writeln(OpenHdr, frmNewTest.edtLowLoad.Text
Writeln(OpenHdr, frmNewTest.edtLowKE.Text);
Writeln(OpenHdr, frmNewTest.edtLowReq.Text)
Writeln(OpenHdr, frmNewTest.edtLowTNoLoad.T
Writeln(OpenHdr, frmNewTest.edtLowTLoad.Tex
CloseFile(OpenHdr);
{ read acheived so far }
FileName := ChangeFileExt(odOpen.FileN
AssignFile(AchFile, FileName);
ReWrite(AchFile);
Writeln(AchFile, frmNewTest.edtHighAch.Text
Writeln(AchFile, frmNewTest.edtLowAch.Text)
CloseFile(AchFile);
end;
finally
frmNewTest.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiAboutCli
var
frmAboutBox: TfrmAboutBox;
begin
frmAboutBox := TfrmAboutBox.CreateWithCap
frmAboutBox.ShowModal;
frmAboutBox.Free;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiReportCl
var
frmTestReport: TfrmTestReport;
begin
OdOpen.Title := 'Report';
if odOpen.Execute then
begin
frmTestReport := TfrmTestReport.CreateWithP
frmTestReport.Caption := 'Test Report - ' + ExtractFileName(odOpen.Fil
try
if frmTestReport.SetupData then frmTestReport.ShowModal;
finally
frmTestReport.Free
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiTripsCli
begin
FfrmTrips.ShowModal;
SaveTrips;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormResize(
begin
gbRight.Left := Round(NB.Width / 2);
gbRight.Width := NB.Width - gbRight.Left - 8;
gbRight.Height := NB.Height - gbRight.Top - 4;
pnlRMachTest.Width := gbRight.Width - pnlRMachTest.Left - 8;
pnlROrderNum.Width := gbRight.Width - pnlROrderNum.Left - 8;
pnlRTyreSize.Width := gbRight.Width - pnlRTyreSize.Left - 8;
lvRight.Width := gbRight.Width - lvRight.Left - 8;
lvRight.Height := gbRight.Height - lvRight.Top - 8;
gbLeft.Width := Round((NB.Width / 2) - 8);
gbLeft.Height := NB.Height - gbLeft.Top - 4;
pnlLMachTest.Width := gbLeft.Width - pnlLMachTest.Left - 8;
pnlLOrderNum.Width := gbLeft.Width - pnlLOrderNum.Left - 8;
pnlLTyreSize.Width := gbLeft.Width - pnlLTyreSize.Left - 8;
lvLeft.Width := gbLeft.Width - lvLeft.Left - 8;
lvLeft.Height := gbLeft.Height - lvLeft.Top - 8;
end;
{-------------------------
procedure TfrmTyreAbsorb.DisableAll;
var
I: Integer;
begin
for I := 0 to mmMain.Items.Count - 1 do
if mmMain.Items[I].Tag = 0 then mmMain.Items[I].Enabled := False;
for I := 0 to mmiSelect.Count - 1 do
if mmiSelect.Items[I].Tag = 0 then mmiSelect.Items[I].Enabled
for I := 0 to tlbMain.ButtonCount - 1 do
if tlbMain.Buttons[I].Tag = 0 then tlbMain.Buttons[I].Enabled
BorderIcons := [];
end;
{-------------------------
procedure TfrmTyreAbsorb.EnableAll;
var
I: Integer;
begin
for I := 0 to mmMain.Items.Count - 1 do
if mmMain.Items[I].Tag = 0 then mmMain.Items[I].Enabled := True;
for I := 0 to mmiSelect.Count - 1 do
if mmiSelect.Items[I].Tag = 0 then mmiSelect.Items[I].Enabled
for I := 0 to tlbMain.ButtonCount - 1 do
if tlbMain.Buttons[I].Tag = 0 then tlbMain.Buttons[I].Enabled
BorderIcons := [biSystemMenu, biMinimize, biMaximize];
end;
{-------------------------
procedure TfrmTyreAbsorb.MyHint(Send
begin
SB.Panels[0].Text := Application.Hint;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadTrips;
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
FfrmTrips.edtName1.Text := ConfigFile.ReadString('Cha
tbTrip1.Hint := FfrmTrips.edtName1.Text;
FfrmTrips.cbType1.ItemInde
FfrmTrips.edtName2.Text := ConfigFile.ReadString('Cha
tbTrip2.Hint := FfrmTrips.edtName2.Text;
FfrmTrips.cbType2.ItemInde
FfrmTrips.edtName3.Text := ConfigFile.ReadString('Cha
tbTrip3.Hint := FfrmTrips.edtName3.Text;
FfrmTrips.cbType3.ItemInde
FfrmTrips.edtName4.Text := ConfigFile.ReadString('Cha
tbTrip4.Hint := FfrmTrips.edtName4.Text;
FfrmTrips.cbType4.ItemInde
FfrmTrips.edtName5.Text := ConfigFile.ReadString('Cha
tbTrip5.Hint := FfrmTrips.edtName5.Text;
FfrmTrips.cbType5.ItemInde
FfrmTrips.edtName6.Text := ConfigFile.ReadString('Cha
tbTrip6.Hint := FfrmTrips.edtName6.Text;
FfrmTrips.cbType6.ItemInde
FfrmTrips.edtName7.Text := ConfigFile.ReadString('Cha
tbTrip7.Hint := FfrmTrips.edtName7.Text;
FfrmTrips.cbType7.ItemInde
FfrmTrips.edtName8.Text := ConfigFile.ReadString('Cha
tbTrip8.Hint := FfrmTrips.edtName8.Text;
FfrmTrips.cbType8.ItemInde
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveTrips;
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
ConfigFile.WriteString('Ch
tbTrip1.Hint := FfrmTrips.edtName1.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip2.Hint := FfrmTrips.edtName2.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip3.Hint := FfrmTrips.edtName3.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip4.Hint := FfrmTrips.edtName4.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip5.Hint := FfrmTrips.edtName5.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip6.Hint := FfrmTrips.edtName6.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip7.Hint := FfrmTrips.edtName7.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip8.Hint := FfrmTrips.edtName8.Text;
ConfigFile.WriteInteger('C
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.CheckTrips;
var
DigInVal: SmallInt;
begin
{ Trip 1 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip1, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip1.ImageIndex := 7
else begin
tbTrip1.ImageIndex := 6;
case FfrmTrips.cbType1.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip1.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip1.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 2 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip2, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip2.ImageIndex := 7
else begin
tbTrip2.ImageIndex := 6;
case FfrmTrips.cbType2.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip2.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip2.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 3 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip3, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip3.ImageIndex := 7
else begin
tbTrip3.ImageIndex := 6;
case FfrmTrips.cbType3.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip3.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip3.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 4 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip4, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip4.ImageIndex := 7
else begin
tbTrip4.ImageIndex := 6;
case FfrmTrips.cbType4.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip4.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip4.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 5 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip5, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then tbTrip5.ImageIndex := 7 { 1 = drive zero? }
else begin
tbTrip5.ImageIndex := 6;
case FfrmTrips.cbType5.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip5.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip5.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 6 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip6, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then tbTrip6.ImageIndex := 7 { 1 = transformer temp. }
else begin
tbTrip6.ImageIndex := 6;
case FfrmTrips.cbType6.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip6.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip6.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 7 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip7, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip7.ImageIndex := 7
else begin
tbTrip7.ImageIndex := 6;
case FfrmTrips.cbType7.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip7.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip7.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 8 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip8, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip8.ImageIndex := 7
else begin
tbTrip8.ImageIndex := 6;
case FfrmTrips.cbType8.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip8.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip8.Hint;
raise ETrip.Create('');
end;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiResultsC
var
Filter: String;
frmSaveTemp: TfrmSaveTemp;
DatFile: TIniFile;
I: Integer;
TS: String;
begin
Filter := odOpen.Filter;
OdOpen.Filter := 'Absorption Results (*.abs)|*.abs';
OdOpen.Title := 'Absorption Results';
try
if OdOpen.Execute then
begin
frmSaveTemp := TfrmSaveTemp.Create(Self);
frmSaveTemp.Caption := 'View test results';
DatFile := TIniFile.Create(odOpen.Fil
frmSaveTemp.edtActual1.Tex
frmSaveTemp.edtActual2.Tex
frmSaveTemp.edtActual3.Tex
frmSaveTemp.edtActual4.Tex
frmSaveTemp.edtActual5.Tex
frmSaveTemp.edtActual6.Tex
frmSaveTemp.edtInital.Text
frmSaveTemp.edtBead.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.edtAmbient.Tex
frmSaveTemp.edtTest.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.edtRise.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.cbEng.Text := DatFile.ReadString('Test',
for I := 0 to 99 do
begin
TS := DatFile.ReadString('Test',
if TS = 'err' then break else frmSaveTemp.memComments.Li
end;
DatFile.Free;
for I := 0 to frmSaveTemp.ComponentCount
begin
if frmSaveTemp.Components[I].
TEdit(frmSaveTemp.Componen
if frmSaveTemp.Components[I].
TEdit(frmSaveTemp.Componen
end;
frmSaveTemp.ShowModal;
frmSaveTemp.Free;
end;
finally
OdOpen.Filter := Filter;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiCoastCli
var
frmCoastMode: TfrmCoastMode;
begin
FCoastType := 0;
frmCoastMode := TfrmCoastMode.Create(Self)
try
if frmCoastMode.ShowModal = mrOk then
begin
FCoastType := frmCoastMode.rgLoad.ItemIn
mmiStartClick(Sender);
end;
finally
frmCoastMode.Free;
end;
end;
{-------------------------
end.
I think it needs the trtchart component adding. There is also another ThrdTimer error message that is basically the same.
When i try and open up the form DunTyreAbsorb.pas i get an error saying
Class TRtChart not found. Ig nore the error and continue?
The trtChart is in a file called Rtchart.pas
unit RtChart;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ChartExt,
ExtCtrls, Printers, Menus, Clipbrd, StdCtrls, Math, ComCtrls;
{*************************
const crMarkerCursor = 25; { custom cursor value }
const xlWBATWorksheet = $FFFFEFB9; { constant needed for excel export }
const ChartMarker = 5;
const CntrMarker = 6;
const NextMarker = 8;
const PrevMarker = 9;
{*************************
type
TRePlot = class;
TRtChart = class(TCustomPanel)
private
FPlot : TBitmap;
FXAxis : TAxis;
FYAxis : TAxis;
FY2Axis : TAxis;
FTitle : TTitle;
FOld : TAxisLimit;
FMarker : TMarker;
FData : array of TDataSeries;
FItems : Integer; { number of series in a chart }
FPlotArea : TRect;
FCoord : TCoord;
FCoordFont : TFont;
FZooming : Boolean;
FOrigin : TPoint;
FMovePt : TPoint;
FHairLineMovePt: TPoint;
FSetHairLine : Boolean;
FTickLength : Integer;
FBoxColor : TColor;
FBoxStyle : TBoxStyle;
FGridStyle : TPenStyle;
FGridColor : TColor;
FHairLines : Boolean;
FRtChartPopUp : TPopUpMenu;
FPopUpItems : array[0..11] of TMenuItem;
FImageList : TImageList;
FXFactor : Single;
FYFactor : Single;
FXOffset : Single;
FYOffset : Single;
FPlotting : Boolean;
function ShiftUp(ASeriesCntr: Integer): integer;
procedure PlotPoint(AWhichSeries: Integer);
procedure ReDrawPlot(ACanvas: TCanvas; AHeight: Integer);
procedure DrawTicks(ACanvas: TCanvas);
procedure DrawTitles(ACanvas: TCanvas);
procedure SetupGrid;
procedure ZoomIn(AStartPoint, AEndPoint :TPoint);
procedure MoveMarker(AShift: TShiftState; AX, AY: Integer);
procedure ShowMarkerCoord(AX, AY: Single; AWhichMarker: Boolean);
procedure DrawMarker(DrawNew: Boolean; X, Y: Single; WhichMarker: Boolean);
procedure PrintClick(Sender: TObject);
procedure ResetZoomClick(Sender: TObject);
procedure ShowMarkersClick(Sender: TObject);
procedure CenterMarkersClick(Sender:
procedure CopyClipBoardClick(Sender:
procedure NextPlotClick(Sender: TObject);
procedure PrevPlotClick(Sender: TObject);
procedure AxisChanged(Sender: TObject);
procedure MoveValiDateXY(ADrawX, ADrawY:Single; var AMoveX, AMoveY: Single);
procedure DrawValiDateXY(AMoveX, AMoveY: Single; var ADrawX, ADrawY: Single);
procedure GotRePlot(Sender: TObject);
protected
procedure Paint; override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);override;
procedure SetTickLength(ATickLength:
procedure SetBoxColor(ABoxColor: TColor);
procedure SetBoxStyle(ABoxStyle: TBoxStyle);
procedure SetGridStyle(AGridStyle: TPenStyle);
procedure SetGridColor(AGridColor: TColor);
procedure SetCoordFont(ACoordFont: TFont);
procedure SetupPopUp;
function GetData(Index: Integer): TDataSeries;
procedure SetData(Index: Integer; Value: TDataSeries);
procedure ReSizePlot(Sender: TObject);
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
Procedure AddSeries(SeriesName: String; PlotColor: TColor;PlotStyle: TPlotStyle);
procedure SetLimits(XMin, XMax, YMin, YMax, XScale, YScale: Single; Num: Integer);
function ReMoveSeries(WhichSeries: Integer): Boolean; overload;
function ReMoveSeries(SeriesName: String): Boolean; overload;
procedure ReMoveAll;
procedure UpDatePlot;
procedure ClearAll;
procedure Add(X, Y: Single; SeriesNumber: Integer);
procedure Print;
procedure ResetPlot;
procedure LinGradFit;
procedure RemoveLinGradFit;
procedure PlotSave(FileName: String);
procedure PlotOpen(FileName: String);
procedure SetDefaults(FileName: String);
procedure GetDefaults(FileName: String);
procedure PlotCsvExport(FileName: String);
procedure PlotExcelExport;
procedure AutoScaleClick(Sender: TObject);
property Items[Index: Integer]: TDataSeries read GetData write SetData;
property Plotting: Boolean read FPlotting write FPlotting;
property Count: Integer read FItems write FItems;
published
property Align;
property Color;
property BevelInner;
property BevelOuter;
property BevelWidth;
property BorderWidth;
property BorderStyle;
property TickLength: Integer read FTickLength write SetTickLength;
property BoxColor: TColor read FBoxColor write SetBoxColor default clWhite;
property BoxStyle: TBoxStyle read FBoxStyle write SetBoxStyle default bsAll;
property GridStyle: TPenStyle read FGridStyle write SetGridStyle default psDash;
property GridColor: TColor read FGridColor write SetGridColor default clGray;
property HairLines: Boolean read FHairLines write FHairLines;
property Coords: TFont read FCoordFont write SetCoordFont;
property XAxis: TAxis read FXAxis write FXAxis;
property YAxis: TAxis read FYAxis write FYAxis;
property Y2Axis: TAxis read FY2Axis write FY2Axis;
property Title: TTitle read FTitle write FTitle;
end;
{*************************
TRePlot = class(TThread)
private
FIdx : Integer;
FMoveX : Single;
FMoveY : Single;
FDrawX : Single;
FDrawY : Single;
FChart : TRtChart;
public
constructor Create(Chart: TRtChart);
procedure Execute; override;
procedure DoReDraw;
function GetChart: TBitmap;
end;
{*************************
procedure Register;
{-------------------------
implementation
uses ExpPro;
{$R RtChart.RES}
{-------------------------
{ TRePlot **************************
{-------------------------
constructor TRePlot.Create(Chart: TRtChart);
begin
FChart := Chart;
Priority := tpTimeCritical;
FreeOnTerminate := True;
inherited Create(False);
end;
{-------------------------
function TRePlot.GetChart: TBitmap;
begin
Result := FChart.FPlot;
end;
{-------------------------
procedure TRePlot.DoReDraw;
begin
with FChart.FPlot do
begin
Canvas.MoveTo(Round(FMoveX
case FChart.FData[FIdx].PlotSty
psLines : Canvas.LineTo(Round(FDrawX
psPoints: if (FMoveX <> FDrawX) and (FMoveY <> FDrawY) then
Canvas.Ellipse(Round(FDraw
end;
end;
end;
{-------------------------
procedure TRePlot.Execute;
var
I, J: Integer;
begin
Screen.Cursor := crHourGlass;
with FChart do
begin
for I := Low(FData) to High(FData) do { do all of the series }
begin
for J := 0 to FData[I].Count do { do all point in each series }
begin
if (FData[I].Count > 1) and (J > 1) then { see if there's more than point to plot }
begin
with FPlot.Canvas, FData[I] do
begin
Pen.Color := PlotColor;
{ move to where the first/last point was }
FMoveX := (GetX(J - 2) * XScale * FXFactor) + FXOffset;
FMoveY := FPlot.Height - (GetY(J - 2) * YScale * FYFactor) - FYOffset;
{ get the lasest plots points }
FDrawX := (GetX(J - 1) * XScale * FXFactor) + FXOffset;
FDrawY := FPlot.Height - (GetY(J - 1) * YScale * FYFactor ) - FYOffset;
MoveValiDateXY(FDrawX, FDrawY, FMoveX, FMoveY);
DrawValiDateXY(FMoveX, FMoveY, FDrawX, FDrawY);
FIdx := I;
Synchronize(DoReDraw);
end;
end;
end;
end;
end;
Screen.Cursor := 0;
end;
{-------------------------
{ TRtChart **************************
{-------------------------
constructor TRtChart.Create(Owner: TComponent);
begin
inherited Create(Owner);
FXAxis := TAxis.Create;
FYAxis := TAxis.Create;
FY2Axis := TAxis.Create;
FTitle := TTitle.Create;
FMarker := TMarker.Create;
FPlot := TBitmap.Create;
FPlot.Transparent := True;
FPlot.TransparentColor := clWhite;
Width := 250;
Height := 250;
Color := clBlack;
FItems := 0;
FCoordFont := TFont.Create;
FCoordFont.Height := 10;
FCoordFont.Color := clWhite;
OnResize := ReSizePlot;
FXAxis.Max := 10;
FXAxis.Min := -10;
FYAxis.Max := 10;
FYAxis.Min := -10;
FY2Axis.Max := 10;
FY2Axis.Min := -10;
FOld.X.Max := FXAxis.Max;
FOld.X.Min := FXAxis.Min;
FOld.Y.Max := FYAxis.Max;
FOld.Y.Min := FYAxis.Min;
FOld.Y2.Max := FY2Axis.Max;
FOld.Y2.Min := FY2Axis.Min;
FXAxis.Interval := 50;
FYAxis.Interval := 50;
FY2Axis.Interval := 50;
FTickLength := 5;
FHairLines := False;
FGridColor := clWhite;
FBoxColor := clWhite;
FGridStyle := psDot;
FGridColor := clGray;
FPlotting := False;
FCoord := TCoord.Create;
FCoord.Canvas.Font.Assign(
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
FY2Axis.OnChange := AxisChanged;
FTitle.OnChange := AxisChanged;
FTitle.Font.OnChange := AxisChanged;
FXAxis.Font.OnChange := AxisChanged;
FYAxis.Font.OnChange := AxisChanged;
FY2Axis.Font.OnChange := AxisChanged;
SetupPopUp; { create popup menu }
{ load custom cursor }
Screen.Cursors[crMarkerCur
end;
{-------------------------
destructor TRtChart.Destroy;
begin
FXAxis.Free;
FYAxis.Free;
FY2Axis.Free;
FTitle.Free;
FCoord.Free;
FCoordFont.Free;
FPlot.Free;
FRtChartPopUp.Free;
FImageList.Free;
FMarker.Free;
inherited Destroy;
end;
{-------------------------
function TRtChart.GetData(Index: Integer): TDataSeries;
begin
Result := FData[Index];
end;
{-------------------------
procedure TRtChart.SetData(Index: Integer; Value: TDataSeries);
begin
FData[Index] := Value;
end;
{-------------------------
procedure TRtCHart.ReSizePlot(Sender
begin
FMarker.Width := Width;
FMarker.Height := 32;
FMarker.Canvas.Brush.Color
FMarker.Canvas.FillRect(Re
FPlot.Canvas.FillRect(Rect
SetupGrid;
if FPlotting then with TRePlot.Create(Self) do OnTerminate := GotRePlot
else ReDrawPlot(FPlot.Canvas, FPlot.Height);
end;
{-------------------------
procedure TRtChart.GotRePlot(Sender:
begin
Paint;
end;
{-------------------------
procedure TRtChart.Paint;
begin
inherited Paint;
SetupGrid;
DrawTicks(Canvas);
DrawTitles(Canvas);
Canvas.Draw(FPlotArea.Left
if FPopUpItems[ChartMarker].C
begin
ShowMarkerCoord(FData[FMar
ShowMarkerCoord(FData[FMar
Canvas.Draw(0, 0, FMarker);
DrawMarker(True, 0, 0, False);
DrawMarker(True, 0, 0, True);
end;
end;
{-------------------------
procedure TRtChart.SetupGrid;
var
MaxWidth, MinWidth: Integer;
begin
if FTitle.ShowTitle then FPlotArea.Top := 10 + FTitle.Font.Height + 10
else FPlotArea.Top := 10 + FYAxis.Font.Height;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
MaxWidth := Round(Canvas.TextWidth(For
MinWidth := Round(Canvas.TextWidth(For
if FYAxis.Max > FYAxis.Min then FPlotArea.Left := 10 + MaxWidth
else FPlotArea.Left := 10 + MinWidth;
MaxWidth := Round(Canvas.TextWidth(For
MinWidth := Round(Canvas.TextWidth(For
if FY2Axis.Max > FY2Axis.Min then FPlotArea.Right := Width - (10 + MaxWidth)
else FPlotArea.Right := Width - (10 + MinWidth);
if FXAxis.ShowTitle then
FPlotArea.Bottom := Height - (FXAxis.Font.Height + 10) * 2
else
FPlotArea.Bottom := Height - FXAxis.Font.Height - 20;
FXFactor := (FPlotArea.Right - FPlotArea.Left) / (FXAxis.Max - FXAxis.Min) ; { X conversion factor }
FYFactor := (FPlotArea.Bottom - FPlotArea.Top) / (FYAxis.Max - FYAxis.Min) ; { Y conversion factor }
FXOffset := FXFactor * FXAxis.Min * -1; { O in the x axis }
FYOffset := FYFactor * FYAxis.Min * -1; { 0 in the y axis }
FPlot.Width := (FPlotArea.Right - FPlotArea.Left);
FPlot.Height := (FPlotArea.Bottom - FPlotArea.Top);
end;
{-------------------------
procedure TRtChart.DrawTicks(ACanvas
var
XSpacer : Single;
YSpacer : Single;
I : Integer;
MajTickCnt: Integer;
begin
XSpacer := (FPlotArea.Right - FPlotArea.Left) / FXAxis.Interval; { get interval division }
YSpacer := (FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval; { get interval division }
if ACanvas = Printer.Canvas then ACanvas.Pen.Color := clBlack
else ACanvas.Pen.Color := FBoxColor;
with ACanvas do
begin
{ Draw the grid box outline if requested }
with FPlotArea do
begin
if FBoxStyle = bsAll then
begin
MoveTo(Left , Top);
LineTo(Left , Bottom);
LineTo(Right, Bottom);
LineTo(Right, Top);
LineTo(Left , Top);
end
else
begin { Draw the XY lines if requested }
MoveTo(Left , Top);
LineTo(Left , Bottom);
LineTo(Right, Bottom);
end;
end;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
MajTickCnt := 0;
for I := 1 to FXAxis.Interval - 1 do { display the ticks }
begin
if FGridStyle <> psClear then
begin
if MajTickCnt > 3 then { draw major gridline every 5 ticks }
begin
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FGridColor;
Pen.Style := FGridStyle; { vertical grid lines }
Pen.Color := FGridColor;
MajTickCnt := 0;
MoveTo(FPlotArea.Left + (Round(XSpacer * I)), FPlotArea.Bottom);
LineTo(FPlotArea.Left + (Round(XSpacer * I)), FPlotArea.Top);
Pen.Style := psSolid;
Pen.Color := FBoxColor;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
end
else Inc(MajTickCnt);
end;
MoveTo(FPlotArea.Left+(Rou
LineTo(FPlotArea.Left+(Rou
if FBoxStyle = bsAll then
begin
MoveTo(FPlotArea.Left+(Rou
LineTo(FPlotArea.Left+(Rou
end;
end;
MoveTo(FPlotArea.Right,FPl
LineTo(FPlotArea.Right,FPl
MajTickCnt :=0;
for I := 1 to FYAxis.Interval - 1 do
begin
if FGridStyle <> psClear then
begin
if MajTickCnt > 3 then { draw major gridline every 5 ticks }
begin
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FGridColor;
Pen.Style := FGridStyle; { horizontal grid lines }
Pen.Color := FGridColor;
MajTickCnt := 0;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Right,FPl
Pen.Style := psSolid;
Pen.Color := FBoxColor;
if ACanvas = Printer.Canvas then Pen.Color := clBlack else Pen.Color := FBoxColor;
end
else Inc(MajTickCnt);
end;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Left+FTic
if FBoxStyle = bsAll then
begin
MoveTo(FPlotArea.Right,FPl
LineTo(FPlotArea.Right-FTi
end;
end;
MoveTo(FPlotArea.Left,FPlo
LineTo(FPlotArea.Left+FTic
end;
end;
{-------------------------
procedure TRtChart.DrawTitles(ACanva
var
TextX, TextY, I: Integer;
XSpacer, YSpacer, AxisValue: Single;
ValStr: String;
begin { get major tick axis label division }
XSpacer := ((FPlotArea.Right-FPlotAre
TextY := FPlotArea.Bottom + 5;
with ACanvas do
begin
Font.Assign(FXAxis.Font); { get x asis font setup }
if ACanvas = Printer.Canvas then Font.Color := clBlack;
for I := 0 to Round(FXAxis.Interval / 5) do
begin
AxisValue := FXAxis.Min + (I * (FXAxis.Max - FXAxis.Min) / (FXAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextX := Round(I * XSpacer + FPlotArea.Left);
TextOut(Round(TextX - (TextWidth(ValStr) / 2)), TextY , ValStr);
end;
Font.Assign(FYAxis.Font); { get y axis font setup }
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := FPlotArea.Left - 5;
YSpacer := ((FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval) * 5;
for I := 0 to Round(FYAxis.Interval / 5) do
begin
AxisValue := FYAxis.Min + (I * (FYAxis.Max - FYAxis.Min) / (FYAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextY := Round(FPlotArea.Bottom - (I * YSpacer) - (TextHeight(ValStr) / 2));
if (FXAxis.Min <> FYAxis.Min) or (AxisValue <> FXAxis.Min) then
TextOut(Round(TextX - TextWidth(ValStr)), TextY, ValStr);
end;
Font.Assign(FY2Axis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := FPlotArea.Right + 5;
YSpacer := ((FPlotArea.Bottom - FPlotArea.Top) / FYAxis.Interval) * 5;
for I := 0 to Round(FYAxis.Interval / 5) do
begin
AxisValue := FY2Axis.Min + (I * (FY2Axis.Max - FY2Axis.Min) / (FYAxis.Interval / 5));
ValStr := FormatFloat('0.###', AxisValue);
TextY := Round(FPlotArea.Bottom - (I * YSpacer) - (TextHeight(ValStr) / 2));
// if (FXAxis.Min <> FXAxis.Min) or (AxisValue <> FXAxis.Min) then
// TextOut(Round(TextX - TextWidth(ValStr)), TextY, ValStr);
TextOut(TextX, TextY, ValStr);
end;
if FTitle.ShowTitle then
begin { Display main Title if needed }
Font.Assign(FTitle.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := Round(((FPlotArea.Right - FPlotArea.Left) / 2) - (TextWidth(FTitle.Title) / 2)) + FPlotArea.Left;
TextY := FPlotArea.Top - TextHeight(FTitle.Title) - 10;
TextOut(TextX,TextY,FTitle
end;
if FYAxis.ShowTitle then
begin { Display Y Titles if needed }
Font.Assign(FYAxis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
TextX := 5;
TextOut(TextX,TextY,FYAxis
end;
if FY2Axis.ShowTitle then
begin { Display Y2 Titles if needed }
Font.Assign(FY2Axis.Font);
if ACanvas = Printer.Canvas then
begin
Font.Color := clBlack;
TextX := Printer.PageWidth - TextWidth(FY2Axis.Title) - 5;
TextY := Printer.PageHeight - TextHeight(FY2Axis.Title) - 5;
end
else begin
TextX := Width - TextWidth(FY2Axis.Title) - 5;
TextY := Height - TextHeight(FY2Axis.Title) - 5;
end;
TextOut(TextX,TextY,FY2Axi
end;
if FXAxis.ShowTitle then
begin { Display X Titles if needed }
Font.Assign(FXAxis.Font);
if ACanvas = Printer.Canvas then Font.Color := clBlack;
TextX := Round(((FPlotArea.Right + FPlotArea.left) / 2) - (TextWidth(FXAxis.Title) / 2));
if ACanvas = Printer.Canvas then TextY := FPlotArea.Bottom + FXAxis.Font.Height + 100
else TextY := FPlotArea.Bottom + FXAxis.Font.Height + 10;
TextOut(TextX,TextY,FXAxis
end;
end;
end;
{-------------------------
procedure TRtChart.PlotPoint(AWhichS
var
MoveX, MoveY, DrawX, DrawY: Single;
DataPtr: Integer;
begin
FPlot.Canvas.Pen.Color := FData[AWhichSeries].PlotCo
FPlot.Canvas.Pen.Style := psSolid;
with FData[AWhichSeries] do
begin
DataPtr := Count - 2; { move to where the first/last point was }
MoveX := (GetX(DataPtr) * XScale * FXFactor) + FXOffset;
MoveY := FPlot.Height - GetY(DataPtr) * YScale * FYFactor - FYOffset;
DataPtr := Count - 1; { get the lasest plots points }
DrawX := (GetX(DataPtr) * XScale * FXFactor) + FXOffset;
DrawY := FPlot.Height - GetY(DataPtr) * YScale * FYFactor - FYOffset;
end;
FPlot.Canvas.MoveTo(Round(
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
case FData[AWhichSeries].PlotSt
psLines: FPlot.Canvas.LineTo(Round(
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then FPlot.Canvas.Ellipse(
Round(DrawX + 1),Round(DrawY + 1),Round(DrawX - 1),Round(DrawY - 1));
end;
Canvas.Pen.Color := FData[AWhichSeries].PlotCo
Canvas.Pen.Style := psSolid;
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
MoveX := MoveX + FPlotArea.Left;
MoveY := MoveY + FPlotArea.Top;
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
DrawX := DrawX + FPlotArea.Left;
DrawY := DrawY + FPlotArea.Top;
Canvas.MoveTo(Round(MoveX)
case FData[AWhichSeries].PlotSt
psLines: Canvas.LineTo(Round(DrawX)
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then Canvas.Ellipse(
Round(DrawX + 1),Round(DrawY + 1),Round(DrawX - 1),Round(DrawY - 1));
end;
end;
{-------------------------
{ redraws the graph if there's any data available }
procedure TRtChart.ReDrawPlot(ACanva
var
MoveX, MoveY, DrawX, DrawY: Single;
I, J: Integer;
begin
Cursor := crHourGlass;
for I := Low(FData) to High(FData) do { do all of the series }
begin
if FData[I].Show then { if wish to plot series }
begin
for J := 0 to FData[I].Count do { do all point in each series }
begin
if (FData[I].Count > 1) and (J > 1) then { see if there's more than point to plot }
begin
with ACanvas, FData[I] do
begin
Pen.Color := PlotColor;
{ move to where the first/last point was }
MoveX := GetX(J - 2) * XScale * FXFactor + FXOffset;
MoveY := AHeight - GetY(J - 2) * YScale * FYFactor - FYOffset;
{ get the lasest plots points }
DrawX := GetX(J - 1) * XScale * FXFactor + FXOffset;
DrawY := AHeight - GetY(J - 1) * YScale * FYFactor - FYOffset;
MoveValiDateXY(DrawX, DrawY, MoveX, MoveY);
DrawValiDateXY(MoveX, MoveY, DrawX, DrawY);
if ACanvas = Printer.Canvas then { offset them if printing }
begin
MoveX := MoveX + FPlotArea.Left;
MoveY := MoveY + FPlotArea.Top;
DrawX := DrawX + FPlotArea.Left;
DrawY := DrawY + FPlotArea.Top;
end;
MoveTo(Round(MoveX),Round(
case FData[I].PlotStyle of
psLines : LineTo(Round(DrawX),Round(
psPoints: if (MoveX <> DrawX) and (MoveY <> DrawY) then
Ellipse(Round(DrawX+1),Rou
end;
end;
end;
end;
end;
end;
Cursor := crArrow;
end;
{-------------------------
procedure TRtChart.UpDatePlot;
begin
ReSizePlot(Owner);
Paint;
end;
{-------------------------
Procedure TRtChart.AddSeries (SeriesName: String; PlotColor: TColor; PlotStyle: TPlotStyle);
begin { add a new series with parameters given }
SetLength (FData, FItems + 1);
FData[FItems] := TDataSeries.Create;
FData[FItems].PlotName := SeriesName;
FData[FItems].PlotColor := PlotColor;
FData[FItems].PlotStyle := PlotStyle;
Inc(FItems);
end;
{-------------------------
{ provides the means for multiple axis displays }
procedure TRtChart.SetLimits(XMin, XMax, YMin, YMax, XScale, YScale: Single; Num: Integer);
begin
FData[Num].XMin := XMin;
FData[Num].XMax := XMax;
FData[Num].YMin := YMin;
FData[Num].YMax := YMax;
FData[Num].XScale := XScale;
FData[Num].YScale := YScale;
end;
{-------------------------
{ removes a series given the series number }
function TRtChart.ReMoveSeries(Whic
var
SeriesCntr: Integer;
begin
if WhichSeries <= FItems then { is it a valid series number? }
begin { is is last series in set? }
if WhichSeries = Fitems then FData[WhichSeries].Destroy
else
begin
SeriesCntr := WhichSeries;
{ series in the middle so move up }
while SeriesCntr+1 <> FItems do SeriesCntr := ShiftUp(SeriesCntr);
end;
result := True; { Destroy last series as all have been moved up }
FData[FItems - 1].Destroy;
end
else result := False;
Dec(FItems);
setLength(FData, FItems); { resize the series set }
ReSizePlot(Owner);
Paint;
end;
{-------------------------
{ removes a series given the series name }
function TRtChart.ReMoveSeries(Seri
var
SeriesCntr: Integer;
begin
SeriesCntr := 1;
Result := True;
if FItems <> 1 then { Series set, not empty }
begin
while FData[SeriesCntr].PlotName
begin
if SeriesCntr = FItems-1 then { Series does not exist }
begin
Result := False;
break;
end;
inc(SeriesCntr);
end;
{ Series in the set and the rest needs to be moved up }
while (SeriesCntr + 1 <> FItems) and (Result = True) do
SeriesCntr := ShiftUp(SeriesCntr);
if Result <> False then { Series sets dealt with delete last entry }
begin
FData[FItems - 1].Destroy;
Dec(FItems);
SetLength(FData, FItems); { resize the series set }
end
end else Result := False;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.ReMoveAll;
var
I: Integer;
begin
for I:= Low(FData) to High(FData) do FData[I].free;
SetLength(FData, 0);
FItems := 0;
ReSizePlot(Self);
Paint;
end;
{-------------------------
procedure TRtChart.ClearAll;
var
I: Integer;
begin
for I:= Low(FData) to High(FData) do FData[I].Clear;
ReSizePlot(Self);
Paint;
end;
{-------------------------
procedure TRtChart.Add(X, Y : Single; SeriesNumber: Integer);
begin
FData[SeriesNumber].Add(X,
{ see if there's more than point to plot }
if (FData[SeriesNumber].Count
PlotPoint(SeriesNumber);
end;
{-------------------------
function TRtChart.ShiftUp(ASeriesCn
var
I: Integer;
begin
FData[ASeriesCntr].PlotCol
FData[ASeriesCntr].PlotSty
FData[ASeriesCntr].PlotNam
FData[ASeriesCntr].Count := FData[ASeriesCntr+1].Count
{ Transfer the X&Y Data from the next object into this object }
FData[ASeriesCntr].Clear;
for I:= Low(FData) to High(FData) do
begin
if FData[ASeriesCntr+1].Count
FData[ASeriesCntr].Add(FDa
FData[ASeriesCntr+1].GetY(
end;
inc(ASeriesCntr);
Result := ASeriesCntr;
end;
{-------------------------
procedure TRtChart.SetCoordFont(ACoo
begin
if ACoordFont <> FCoordFont then FCoordFont.Assign(ACoordFo
end;
{-------------------------
procedure TRtChart.SetTickLength(ATi
begin
if ATickLength <> FTickLength then
begin
FTickLength := ATickLength;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetGridColor(AGri
begin
if AGridColor <> FGridColor then
begin
FGridColor := AGridColor;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetBoxStyle(ABoxS
begin
if ABoxStyle <> FBoxStyle then
begin
FBoxStyle := ABoxStyle;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetGridStyle(AGri
begin
if AGridStyle <> FGridStyle then
begin
FGridStyle := AGridStyle;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.SetBoxColor(ABoxC
begin
if ABoxColor <> FBoxColor then
begin
FBoxColor := ABoxColor;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.MouseMove(Shift: TShiftState; X, Y: Integer);
var
XString, YString: String;
begin
Canvas.Font.Assign(FCoordF
if FPopUpItems[ChartMarker].C
{ draw zoom box only if not wishing to move a marker}
if FZooming and (ssLeft in Shift) then
begin
with Canvas do
begin
if Color = clWhite then Pen.Color := clBlack else Pen.Color := clWhite;
Pen.Style := psDot;
Pen.Mode := pmXor;
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(FMovePt.X, FOrigin.Y); { erase old lines }
LineTo(FMovePt.X, FMovePt.Y);
LineTo(FOrigin.X, FMovePt.Y);
LineTo(FOrigin.X, FOrigin.Y);
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(X, FOrigin.Y); { draw new box }
LineTo(X, Y);
LineTo(FOrigin.X, Y);
LineTo(FOrigin.X, FOrigin.Y);
Pen.Style := psSolid;
end;
FMovePt := Point(X, Y);
end;
{ Display graph and change cursor only when within plot area }
if (X >= FPlotArea.Left) and (X <= FPlotArea.Right) and
(Y >= FPlotArea.Top) and (Y <= FPlotArea.Bottom) then
begin
with Canvas do
begin
Pen.Mode := pmXor;
Pen.Color := FBoxColor;
Pen.Style := psSolid;
if FHairLines then { Draw hairlines if requested }
begin
if not FSetHairLine then
begin
MoveTo(FHairLineMovePt.X,F
LineTo(FHairLineMovePt.X,F
MoveTo(FPlotArea.Left,FHai
LineTo(FPlotArea.Right,FHa
end;
Cursor := crNone;
FSetHairLine := False;
MoveTo(X,FPlotArea.Top); { draw new lines }
LineTo(X,FPlotArea.Bottom)
MoveTo(FPlotArea.Left,Y);
LineTo(FPlotArea.Right,Y);
FHairLineMovePt := Point(X, Y);
end
{ default cursor only not moving a marker }
else if Cursor <> crMarkerCursor then Cursor := crCross;
{ display real coord values }
FCoord.Canvas.Brush.Color := Color;
XString := ' X = ' + FormatFloat('0.00', (X - FPlotArea.Left - FXOffset) / FXFactor);
YString := ' Y = ' + FormatFloat('0.00', (FPlotArea.Bottom - Y - FYOffset) / FYFactor);
with FCoord.Canvas do
begin
if TextWidth(XString) > TextWidth(YString) then FCoord.Width := TextWidth(XString)
else FCoord.Width := TextWidth(YString);
FCoord.Height := TextHeight(XString) + TextHeight(YString);
FCoord.Canvas.FillRect(Rec
TextOut(0,0,XString);
TextOut(0,TextHeight(YStri
end;
end;
end
else
begin
Cursor := crArrow;
with Canvas do
begin { cursor out of range so don't display cursor position }
FCoord.Canvas.Brush.Color := Color;
XString := ' X = ????';
YString := ' Y = ????';
with FCoord.Canvas do
begin
if TextWidth(XString) > TextWidth(YString) then FCoord.Width := TextWidth(XString)
else FCoord.Width := TextWidth(YString);
FCoord.Height := TextHeight(XString) + TextHeight(YString);
TextOut(0,0,XString);
TextOut(0,TextHeight(YStri
end;
end;
end;
if FPopUpItems[ChartMarker] <> nil then
if FPopUpItems[ChartMarker].C
Canvas.Draw(Width - FCoord.Width - 5, 5 + FMarker.Height, FCoord)
else
Canvas.Draw(Width - FCoord.Width - 5, 5, FCoord);
Canvas.Pen.Mode := pmCopy;
end;
{-------------------------
procedure TRtChart.MouseDown(Button:
begin
if FPlotting then PopUpMenu := nil else PopUpMenu := FRtChartPopUp;
{ within upper marker limit }
with FMarker.Upper do
begin
if (X > Point.x - 5)and(X < Point.x + 5)and(Y > Point.y - 15)and(Y < Point.y) then
begin
Cursor := crMarkerCursor;
FMarker.Lower.Selected := False; { make sure only one marker is moving at one time }
with FMarker.Upper do
if (ssLeft in Shift) then Selected := True else Selected := False;
end;
end;
with FMarker.Lower do { within Lower marker limit }
begin
if (X > Point.x - 5)and(X < Point.x + 5)and(Y > Point.y)and(Y < Point.y + 15) then
begin
Cursor := crMarkerCursor;
FMarker.Upper.Selected := False; { make sure only one marker is moving at one time }
if (ssLeft in Shift) then Selected := True else Selected := False;
end;
end;
{ user wanting to zoom in }
if (Button = mbLeft) and not FMarker.Upper.Selected and not FMarker.Lower.Selected then
begin
Canvas.MoveTo(X,Y);
FZooming := True;
FOrigin := Point(X, Y);
FMovePt := Point(X, Y);
end;
end;
{-------------------------
procedure TRtChart.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
{ only zoom in if not tring to move a marker or if previous point is the same as the
now point. }
if FZooming and (FOrigin.X <> FMovePt.X) and (FOrigin.Y <> FMovePt.Y) and
not FMarker.Upper.Selected and not FMarker.Lower.Selected then
begin
FZooming := False;
with Canvas do
begin
Pen.Mode := pmXor;
MoveTo(FOrigin.X, FOrigin.Y); { move pen back to origin }
LineTo(FMovePt.X, FOrigin.Y); { erase old lines }
LineTo(FMovePt.X, FMovePt.Y);
LineTo(FOrigin.X, FMovePt.Y);
LineTo(FOrigin.X, FOrigin.Y);
Pen.Mode := pmCopy;
end;
ZoomIn(FOrigin,FMovePt);
end;
FMarker.Upper.Selected := False; {disable the abiltity to redraw markers }
FMarker.Lower.Selected := False;
end;
{-------------------------
procedure TRtChart.DrawMarker(DrawNe
var
TmpX, TmpY: Integer;
begin
with FData[FMarker.DataIdx], FMarker, FPlotArea do
begin
TmpX := Round(Left + GetX(Upper.Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Upper.Idx)* FYFactor * YScale) - FYOffset);
Upper.Point := Point(TmpX, TmpY);
TmpX := Round(Left + GetX(Lower.Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Lower.Idx)* FYFactor * YScale) - FYOffset);
Lower.Point := Point(TmpX, TmpY);
end;
if not WhichMarker then
begin
{ erase old upper marker or redraw new }
Canvas.MoveTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
Canvas.LineTo(FMarker.Uppe
end
else
begin
{ erase old upper marker or redraw new }
Canvas.MoveTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
Canvas.LineTo(FMarker.Lowe
end;
if not DrawNew then exit;
if not WhichMarker then
begin
{ draw new upper marker }
Canvas.MoveTo(Round(X) , Round(Y) );
Canvas.LineTo(Round(X) - 5, Round(Y) -15);
Canvas.LineTo(Round(X) + 5, Round(Y) -15);
Canvas.LineTo(Round(X) , Round(Y));
end
else
begin
{ draw new lower marker }
Canvas.MoveTo(Round(X) , Round(Y) );
Canvas.LineTo(Round(X) - 5, Round(Y) +15);
Canvas.LineTo(Round(X) + 5, Round(Y) +15);
Canvas.LineTo(Round(X) , Round(Y));
end;
end;
{-------------------------
procedure TRtChart.MoveMarker(AShift
var
I: Integer;
NewX, NewY: Single;
begin
Cursor := crCross; { set to default cursor if not moving a marker }
with FMarker.Upper.Point do
begin
if (AX > x - 5)and(AX < x + 5)and(AY > y - 15)and(AY < y) then
Cursor := crMarkerCursor; { within upper marker limit change cursor }
end;
with FMarker.Lower.Point do
begin
if (AX > x - 5)and(AX < x + 5)and(AY > y)and(AY < y + 15) then
Cursor := crMarkerCursor; { within lower marker limit change cursor }
end;
{ draw upper marker new position }
if FMarker.Upper.Selected or FMarker.Lower.Selected and (ssLeft in AShift) then
begin
for I:= 0 to FData[FMarker.DataIdx].Cou
begin
with FData[FMarker.DataIdx], FPlotArea do
begin
NewX := Left + GetX(I) * FXFactor * XScale + FXOffset;
NewY := Top + FPlot.Height - (GetY(I) * FYFactor * YScale) - FYOffset;
end;
if (NewY > AY - 10)and(NewY < AY + 10)and(NewX > AX - 10)and(NewX < AX + 10) then
begin
if FMarker.Upper.Selected then
begin
{ display the coordinates of the upper marker }
with FData[FMarker.DataIdx] do ShowMarkerCoord(GetX(I), GetY(I), False);
Canvas.Pen.Mode := pmXor;
DrawMarker(True, NewX, NewY, False);
Canvas.Pen.Mode := pmCopy;
FMarker.Upper.Idx := I;
FMarker.Upper.Point := Point(Round(NewX), Round(NewY));
end
else
begin
{ display the coordinates of the lower marker }
with FData[FMarker.DataIdx] do ShowMarkerCoord(GetX(I), GetY(I), True);
Canvas.Pen.Mode := pmXor;
DrawMarker(True, NewX, NewY, True);
Canvas.Pen.Mode := pmCopy;
FMarker.Lower.Idx := I;
FMarker.Lower.Point := Point(Round(NewX), Round(NewY));
end;
end;
end;
end;
Canvas.Draw(0, 0, FMarker);
end;
{-------------------------
procedure TRtChart.Print;
var
FPrintDialog : TPrintDialog;
BackupFPlotArea, PrtGrid : TRect;
MaxWidth, MinWidth: Integer;
OldXFactor, OldYFactor, OldXOffset, OldYOffset: Single;
begin
OldXFactor := FXFactor;
OldYFactor := FYFactor;
OldXOffset := FXOffset;
OldYOffset := FYOffset;
FPrintDialog := TPrintDialog.Create(Self);
if FPrintDialog.Execute then
begin
Printer.Title := 'Servocon Plot';
Printer.BeginDoc; { start printing }
with Printer.Canvas do
begin
if FTitle.ShowTitle then PrtGrid.Top := 100 + TextHeight(FTitle.Title) + 100
else PrtGrid.Top := 100 + TextHeight(FTitle.Title);
MaxWidth := Round(TextWidth(FormatFloa
MinWidth := Round(TextWidth(FormatFloa
if FYAxis.Max > FYAxis.Min then PrtGrid.Left := 50 + MaxWidth
else PrtGrid.Left := 50 + MinWidth;
MaxWidth := Round(TextWidth(FormatFloa
MinWidth := Round(TextWidth(FormatFloa
if FY2Axis.Max > FY2Axis.Min then PrtGrid.Right := Printer.PageWidth - (10 + MaxWidth)
else PrtGrid.Right := Printer.PageWidth - (10 + MinWidth);
if FXAxis.ShowTitle then
PrtGrid.Bottom := Printer.PageHeight - (TextHeight(FXAxis.Title)+
else
PrtGrid.Bottom := Printer.PageHeight - TextHeight(FXAxis.Title) - 100;
end;
BackupFPlotArea := FPlotArea;
FPlotArea := PrtGrid;
FXFactor := (FPlotArea.Right - FPlotArea.Left) / (FXAxis.Max - FXAxis.Min) ; { X conversion factor }
FYFactor := (FPlotArea.Bottom - FPlotArea.Top) / (FYAxis.Max - FYAxis.Min) ; { Y conversion factor }
FXOffset := FXFactor * FXAxis.Min * -1; { O in the x axis }
FYOffset := FYFactor * FYAxis.Min * -1; { 0 in the y axis }
DrawTitles(Printer.Canvas)
DrawTicks(Printer.Canvas);
ReDrawPlot(Printer.Canvas,
FPlotArea := BackupFPlotArea;
Printer.EndDoc; { finish printing }
end;
FPrintDialog.Free;
FXFactor := OldXFactor;
FYFactor := OldYFactor;
FXOffset := OldXOffset;
FYOffset := OldYOffset;
end;
{-------------------------
procedure TRtChart.ZoomIn(AStartPoin
var
TempCopy: Single;
begin
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
{ User drawn zoom box normally i.e. top left to bottom right }
if AStartPoint.X <= AEndPoint.X then
begin
TempCopy := FXAxis.Min;
FXAxis.Min := FXAxis.Min + ((AStartPoint.X - FPlotArea.Left) / FXFactor);
FXAxis.Max := TempCopy + ((AEndPoint.X - FPlotArea.Left) / FXFactor);
end
else { User drawn zoom box abnormally i.e. bottom right to top left}
begin
TempCopy := FXAxis.Min;
FXAxis.Min := FXAxis.Min + ((AEndPoint.X - FPlotArea.Left) / FXFactor);
FXAxis.Max := TempCopy + ((AStartPoint.X - FPlotArea.Left) / FXFactor);
end;
{ User drawn zoom box normally i.e. top left to bottom right }
if AStartPoint.Y <= AEndPoint.Y then
begin
TempCopy := FYAxis.Max;
FYAxis.Max := FYAxis.Max - ((AStartPoint.Y - FPlotArea.Top) / FYFactor);
FYAxis.Min := TempCopy - ((AEndPoint.Y - FPlotArea.Top) / FYFactor);
end
else { User drawn zoom box abnormally i.e. bottom right to top left}
begin
TempCopy := FYAxis.Max;
FYAxis.Max := FYAxis.Max - ((AEndPoint.Y - FPlotArea.Top) / FYFactor);
FYAxis.Min := TempCopy - ((AStartPoint.Y - FPlotArea.Top) / FYFactor);
end;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.ResetPlot;
begin
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
FXAxis.Max := FOld.X.Max;
FXAxis.Min := FOld.X.Min;
FYAxis.Max := FOld.Y.Max;
FYAxis.Min := FOld.Y.Min;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.PrintClick(Sender
begin
Print;
end;
{-------------------------
procedure TRtChart.ResetZoomClick(Se
begin
ResetPlot;
end;
{-------------------------
procedure TRtChart.SetupPopUp;
var
PrintImage : TBitMap;
Zoom1Image : TBitMap;
CenterImage : TBitMap;
CopyClipImage : TBitMap;
NextPLotImage : TBitMap;
PrevPlotImage : TBitMap;
AutoScaleImage: TBitMap;
begin
FRtChartPopUp := TPopUpMenu.Create(Self);
FImageList := TImageList.Create(Self);
PopUpMenu := FRtChartPopUp;
PopUpMenu.Images := FImageList;
PrintImage := TBitmap.Create;
PrintImage.LoadFromResourc
PrintImage.Transparent := True;
FPopUpItems[0] := TMenuItem.Create(Self);
FImageList.AddMasked(Print
FPopUpItems[0].ImageIndex := 0;
FPopUpItems[0].Caption := '&Print';
FPopUpItems[0].OnClick := PrintClick;
FRtChartPopUp.Items.Add(FP
FPopUpItems[1] := TMenuItem.Create(Self);
FPopUpItems[1].Caption := '-';
FRtChartPopUp.Items.Add(FP
Zoom1Image := TBitmap.Create;
Zoom1Image.LoadFromResourc
Zoom1Image.Transparent := True;
FPopUpItems[2] := TMenuItem.Create(Self);
FImageList.AddMasked(Zoom1
FPopUpItems[2].ImageIndex := 1;
FPopUpItems[2].Caption := '&Zoom x1';
FPopUpItems[2].OnClick := ResetZoomClick;
FRtChartPopUp.Items.Add(FP
AutoScaleImage := TBitmap.Create;
AutoScaleImage.LoadFromRes
AutoScaleImage.Transparent
FPopUpItems[3] := TMenuItem.Create(Self);
FImageList.AddMasked(AutoS
FPopUpItems[3].ImageIndex := 2;
FPopUpItems[3].Caption := '&Auto Scale';
FPopUpItems[3].OnClick := AutoScaleClick;
FRtChartPopUp.Items.Add(FP
FPopUpItems[4] := TMenuItem.Create(Self);
FPopUpItems[4].Caption := '-';
FRtChartPopUp.Items.Add(FP
FPopUpItems[ChartMarker] := TMenuItem.Create(Self);
FPopUpItems[ChartMarker].C
FPopUpItems[ChartMarker].O
FRtChartPopUp.Items.Add(FP
CenterImage := TBitmap.Create;
CenterImage.LoadFromResour
CenterImage.Transparent := True;
FPopUpItems[6] := TMenuItem.Create(Self);
FImageList.AddMasked(Cente
FPopUpItems[6].ImageIndex := 3;
FPopUpItems[6].Caption := 'Center &Markers';
FPopUpItems[6].OnClick := CenterMarkersClick;
FPopUpItems[6].Enabled := False;
FRtChartPopUp.Items.Add(FP
FPopUpItems[7] := TMenuItem.Create(Self);
FPopUpItems[7].Caption := '-';
FRtChartPopUp.Items.Add(FP
NextPlotImage := TBitmap.Create;
NextPlotImage.LoadFromReso
NextPlotImage.Transparent := True;
FPopUpItems[8] := TMenuItem.Create(Self);
FImageList.AddMasked(NextP
FPopUpItems[8].ImageIndex := 4;
FPopUpItems[8].Caption := 'Mark &Next Plot';
FPopUpItems[8].OnClick := NextPlotClick;
FPopUpItems[8].Enabled := False;
FRtChartPopUp.Items.Add(FP
PrevPlotImage := TBitmap.Create;
PrevPlotImage.LoadFromReso
PrevPlotImage.Transparent := True;
FPopUpItems[9] := TMenuItem.Create(Self);
FImageList.AddMasked(PrevP
FPopUpItems[9].ImageIndex := 5;
FPopUpItems[9].Caption := 'Mark P&rev Plot';
FPopUpItems[9].OnClick := PrevPlotClick;
FPopUpItems[9].Enabled := False;
FRtChartPopUp.Items.Add(FP
FPopUpItems[10] := TMenuItem.Create(Self);
FPopUpItems[10].Caption := '-';
FRtChartPopUp.Items.Add(FP
CopyClipImage := TBitmap.Create;
CopyClipImage.LoadFromReso
CopyClipImage.Transparent := True;
FPopUpItems[11] := TMenuItem.Create(Self);
FImageList.AddMasked(CopyC
FPopUpItems[11].ImageIndex
FPopUpItems[11].BitMap := CopyClipImage;
FPopUpItems[11].Caption := '&Copy to ClipBoard';
FPopUpItems[11].OnClick := CopyClipBoardClick;
FRtChartPopUp.Items.Add(FP
AutoScaleImage.Free;
PrintImage.Free;
Zoom1Image.Free;
CenterImage.Free;
CopyClipImage.Free;
NextPLotImage.Free;
PrevPlotImage.Free;
end;
{-------------------------
procedure TRtChart.ShowMarkersClick(
var
TmpX, TmpY, Idx: Integer;
Begin
if FPopUpItems[ChartMarker].C
else FPopUpItems[ChartMarker].C
if FPopUpItems[ChartMarker].C
begin
if FItems > 0 then { if no plot data don't show markers and bring up an error }
begin
FMarker.DataIdx := 0;
FMarker.Upper.Idx := Round(FData[0].Count / 2);
FMarker.Lower.Idx := Round(FData[0].Count / 2);
Idx := FMarker.Upper.Idx;
with FData[0], FPlotArea do
begin
TmpX := Round(Left + GetX(Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Idx)* FYFactor * YScale) - FYOffset);
end;
FMarker.Upper.Point := Point(TmpX, TmpY);
FMarker.Lower.Point := Point(TmpX, TmpY);
ResizePlot(Owner);
Paint; { first paint screen with new limits }
DrawMarker(True, 0, 0, False);
DrawMarker(True, 0, 0, True);
FPopUpItems[ChartMarker].C
if FItems < 2 then
FPopUpItems[CntrMarker].En
else
begin
FPopUpItems[CntrMarker].En
FPopUpItems[NextMarker].En
end;
end
else
begin
Application.MessageBox('No
FPopUpItems[ChartMarker].C
end;
end
else
begin { disable marker routines is there are markers on the graph }
FPopUpItems[CntrMarker].En
FPopUpItems[NextMarker].En
FPopUpItems[PrevMarker].En
ResizePlot(Owner);
Paint; { removed markers refresh screen }
end;
end;
{-------------------------
procedure TRtChart.CenterMarkersClic
var
Idx, TmpX, TmpY: Integer;
Begin
FMarker.Upper.Idx := Round(FData[FMarker.DataId
FMarker.Lower.Idx := Round(FData[FMarker.DataId
Idx := FMarker.Upper.Idx;
with FData[FMarker.DataIdx], FPlotArea do
begin
TmpX := Round(Left + GetX(Idx)* FXFactor * XScale + FXOffset);
TmpY := Round(Top + FPlot.Height - (GetY(Idx)* FYFactor * YScale) - FYOffset);
end;
FMarker.Upper.Point := Point(TmpX, TmpY);
FMarker.Lower.Point := Point(TmpX, TmpY);
Paint; { first paint screen with new limits }
end;
{-------------------------
procedure TRtChart.NextPlotClick(Sen
begin
if FMarker.DataIdx < FItems-1 then
begin
FPopUpItems[PrevMarker].En
FMarker.DataIdx := FMarker.DataIdx + 1; { inc dataidx }
if FMarker.DataIdx = FItems - 1 then
FPopUpItems[NextMarker].En
else FPopUpItems[NextMarker].En
FMarker.Lower.Idx := Round(FData[FMarker.DataId
FMarker.Upper.Idx := Round(FData[FMarker.DataId
ReSizePlot(Owner);
Paint;
end
end;
{-------------------------
procedure TRtChart.PrevPlotClick(Sen
begin
if FMarker.DataIdx > 0 then
begin
FPopUpItems[NextMarker].En
FMarker.DataIdx := FMarker.DataIdx - 1;
if FMarker.DataIdx = 0 then FPopUpItems[PrevMarker].En
else FPopUpItems[PrevMarker].En
FMarker.Lower.Idx := Round(FData[FMarker.DataId
FMarker.Upper.Idx := Round(FData[FMarker.DataId
ReSizePlot(Owner);
Paint;
end
end;
{-------------------------
procedure TRtChart.CopyClipBoardClic
var
GraphCopy: TBitMap;
Source, Dest: TRect;
Begin
Source.Left := 0;
Source.Top := 0;
Source.Bottom := Height;
Source.Right := Width;
Dest := Source;
GraphCopy := TBitMap.Create;
GraphCopy.Height := Height;
GraphCopy.Width := Width;
GraphCopy.Canvas.CopyRect(
Clipboard.Open;
try
Clipboard.Assign(GraphCopy
finally
Clipboard.Close;
end;
GraphCopy.Free;
end;
{-------------------------
procedure TRtChart.PlotOpen(FileName
var
FileHeaderData : TFileHeader;
FilePointsData : TFilePoints;
FileSeriesData : TFileSeries;
iFileHandle, iFileLength, SeriesCount, I: Integer;
begin
iFileHandle := FileOpen(FileName, fmOpenRead);
iFileLength := FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
FileRead(IFileHandle, FileHeaderData, SizeOf(FileHeaderData));
if FileHeaderData.GraphFormat
begin
{ start loading the plot from file }
SeriesCount := FileHeaderData.Count;
FTitle.Title := FileHeaderData.Title.Title
FTitle.ShowTitle := FileHeaderData.Title.ShowT
FTitle.Font.Name := FileHeaderData.Title.Font.
FTitle.Font.Height := FileHeaderData.Title.Font.
FTitle.Font.Color := FileHeaderData.Title.Font.
FTitle.Font.Style := FileHeaderData.Title.Font.
FXAxis.Title := FileHeaderData.XAxis.Title
FXAxis.ShowTitle := FileHeaderData.XAxis.ShowT
FXAxis.Font.Name := FileHeaderData.XAxis.Font.
FXAxis.Font.Height := FileHeaderData.XAxis.Font.
FXAxis.Font.Color := FileHeaderData.XAxis.Font.
FXAxis.Font.Style := FileHeaderData.XAxis.Font.
FXAxis.Interval := FileHeaderData.XAxis.Inter
FXAxis.Max := FileHeaderData.XAxis.Max;
FXAxis.Min := FileHeaderData.XAxis.Min;
FXAxis.Style := FileHeaderData.XAxis.Style
FYAxis.Title := FileHeaderData.YAxis.Title
FYAxis.ShowTitle := FileHeaderData.YAxis.ShowT
FYAxis.Font.Name := FileHeaderData.YAxis.Font.
FYAxis.Font.Height := FileHeaderData.YAxis.Font.
FYAxis.Font.Color := FileHeaderData.YAxis.Font.
FYAxis.Font.Style := FileHeaderData.YAxis.Font.
FYAxis.Interval := FileHeaderData.YAxis.Inter
FYAxis.Max := FileHeaderData.YAxis.Max;
FYAxis.Min := FileHeaderData.YAxis.Min;
FYAxis.Style := FileHeaderData.YAxis.Style
Color := FileHeaderData.BoxColor;
FBoxStyle := FileHeaderData.BoxStyle;
FGridStyle := FileHeaderData.GridStyle;
FGridColor := FileHeaderData.GridColor;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
for I := 0 to SeriesCount - 1 do
begin
FileRead(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
with FileSeriesData do
begin
AddSeries(PlotName, PlotColor, PlotStyle);
SetLimits(XMin, XMax, YMin, YMax, XScale, YScale, SeriesNumber);
end;
end;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
repeat
FileRead(iFileHandle, FilePointsData, SizeOf(FilePointsData));
Add(FilePointsData.XPoint,
until FileSeek(iFileHandle, 0, 1) = iFileLength;
FileClose(iFileHandle);
end
else
begin
FileClose(iFileHandle);
Application.MessageBox('In
'Real Time Chart',MB_OK+MB_ICONINFORM
end;
end;
{-------------------------
procedure TRtChart.PlotSave(FileName
var
iFileHandle: Integer;
FileHeaderData : TFileHeader;
FilePointsData : TFilePoints;
FileSeriesData : TFileSeries;
I, J : Integer;
begin
iFileHandle := FileCreate(FileName);
{ setup record for writting }
FileHeaderData.GraphFormat
FileHeaderData.VerNum := 1;
FileHeaderData.Count := Count;
FileHeaderData.Title.Title
FileHeaderData.Title.ShowT
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.XAxis.Title
FileHeaderData.XAxis.ShowT
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Inter
FileHeaderData.XAxis.Max := FXAxis.Max;
FileHeaderData.XAxis.Min := FXAxis.Min;
FileHeaderData.XAxis.Style
FileHeaderData.YAxis.Title
FileHeaderData.YAxis.ShowT
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Inter
FileHeaderData.YAxis.Max := FYAxis.Max;
FileHeaderData.YAxis.Min := FYAxis.Min;
FileHeaderData.YAxis.Style
FileHeaderData.BoxColor := Color;
FileHeaderData.BoxStyle := FBoxStyle;
FileHeaderData.GridStyle := FGridStyle;
FileHeaderData.GridColor := FGridColor;
{ write record }
FileWrite(iFileHandle, FileHeaderData, SizeOf(FileHeaderData));
{ change the record to write the plot data }
{ Save Series information }
for I := Low(FData) to High(FData) do
begin
FileSeriesData.SeriesNumbe
FileSeriesData.PlotName := FData[I].PlotName;
FileSeriesData.PlotColor := FData[I].PlotColor;
FileSeriesData.PlotStyle := FData[I].PlotStyle;
FileSeriesData.XMax := FData[I].XMax;
FileSeriesData.XMin := FData[I].XMin;
FileSeriesData.YMax := FData[I].YMax;
FileSeriesData.YMin := FData[I].YMin;
FileSeriesData.XScale := FData[I].XScale;
FileSeriesData.YScale := FData[I].YScale;
{ write a single plot }
FileWrite(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
end;
{ change the record to write the plot data }
for I:= Low(FData) to High(FData) do
begin
for J:= 0 to FData[I].Count - 1 do
begin
FilePointsData.SeriesNumbe
FilePointsData.XPoint := FData[I].GetX(J);
FilePointsData.YPoint := FData[I].GetY(J);
{ write a single plot }
FileWrite(iFileHandle, FilePointsData, SizeOf(FilePointsData));
end;
end;
FileClose(IFileHandle);
end;
{-------------------------
procedure TRtChart.SetDefaults(FileN
var
iFileHandle, I: Integer;
FileHeaderData : TFileHeader;
FileSeriesData : TFileSeries;
begin
iFileHandle := FileCreate(FileName);
{ setup record for writting }
FileHeaderData.GraphFormat
FileHeaderData.VerNum := 1;
FileHeaderData.Count := Count;
FileHeaderData.Title.Title
FileHeaderData.Title.ShowT
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.Title.Font.
FileHeaderData.XAxis.Title
FileHeaderData.XAxis.ShowT
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Font.
FileHeaderData.XAxis.Inter
FileHeaderData.XAxis.Max := FXAxis.Max;
FileHeaderData.XAxis.Min := FXAxis.Min;
FileHeaderData.XAxis.Style
FileHeaderData.YAxis.Title
FileHeaderData.YAxis.ShowT
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Font.
FileHeaderData.YAxis.Inter
FileHeaderData.YAxis.Max := FYAxis.Max;
FileHeaderData.YAxis.Min := FYAxis.Min;
FileHeaderData.YAxis.Style
FileHeaderData.BoxColor := Color;
FileHeaderData.BoxStyle := FBoxStyle;
FileHeaderData.GridStyle := FGridStyle;
FileHeaderData.GridColor := FGridColor;
{ write record }
FileWrite(iFileHandle, FileHeaderData, SizeOf(FileHeaderData));
{ change the record to write the plot data }
{ Save Series information }
for I := Low(FData) to High(FData) do
begin
FileSeriesData.SeriesNumbe
FileSeriesData.PlotName := FData[I].PlotName;
FileSeriesData.PlotColor := FData[I].PlotColor;
FileSeriesData.PlotStyle := FData[I].PlotStyle;
FileSeriesData.XMax := FData[I].XMax;
FileSeriesData.XMin := FData[I].XMin;
FileSeriesData.YMax := FData[I].YMax;
FileSeriesData.YMin := FData[I].YMin;
FileSeriesData.XScale := FData[I].XScale;
FileSeriesData.YScale := FData[I].YScale;
{ write a single plot }
FileWrite(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
end;
FileClose(iFileHandle);
end;
{-------------------------
procedure TRtChart.GetDefaults(FileN
var
FileHeaderData : TFileHeader;
FileSeriesData : TFileSeries;
iFileHandle, iFileLength, SeriesCount, I: Integer;
begin
iFileHandle := FileOpen(FileName, fmOpenRead);
iFileLength := FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
FileRead(IFileHandle, FileHeaderData, SizeOf(FileHeaderData));
if FileHeaderData.GraphFormat
begin
{ start loading the plot from file }
SeriesCount := FileHeaderData.Count;
FTitle.Title := FileHeaderData.Title.Title
FTitle.ShowTitle := FileHeaderData.Title.ShowT
FTitle.Font.Name := FileHeaderData.Title.Font.
FTitle.Font.Height := FileHeaderData.Title.Font.
FTitle.Font.Color := FileHeaderData.Title.Font.
FTitle.Font.Style := FileHeaderData.Title.Font.
FXAxis.Title := FileHeaderData.XAxis.Title
FXAxis.ShowTitle := FileHeaderData.XAxis.ShowT
FXAxis.Font.Name := FileHeaderData.XAxis.Font.
FXAxis.Font.Height := FileHeaderData.XAxis.Font.
FXAxis.Font.Color := FileHeaderData.XAxis.Font.
FXAxis.Font.Style := FileHeaderData.XAxis.Font.
FXAxis.Interval := FileHeaderData.XAxis.Inter
FXAxis.Max := FileHeaderData.XAxis.Max;
FXAxis.Min := FileHeaderData.XAxis.Min;
FXAxis.Style := FileHeaderData.XAxis.Style
FYAxis.Title := FileHeaderData.YAxis.Title
FYAxis.ShowTitle := FileHeaderData.YAxis.ShowT
FYAxis.Font.Name := FileHeaderData.YAxis.Font.
FYAxis.Font.Height := FileHeaderData.YAxis.Font.
FYAxis.Font.Color := FileHeaderData.YAxis.Font.
FYAxis.Font.Style := FileHeaderData.YAxis.Font.
FYAxis.Interval := FileHeaderData.YAxis.Inter
FYAxis.Max := FileHeaderData.YAxis.Max;
FYAxis.Min := FileHeaderData.YAxis.Min;
FYAxis.Style := FileHeaderData.YAxis.Style
Color := FileHeaderData.BoxColor;
FBoxStyle := FileHeaderData.BoxStyle;
FGridStyle := FileHeaderData.GridStyle;
FGridColor := FileHeaderData.GridColor;
if iFileLength = FileSeek(iFileHandle,0,1) then
begin
FileClose(iFileHandle);
exit;
end;
for I := 0 to SeriesCount - 1 do
begin
FileRead(iFileHandle, FileSeriesData, SizeOf(FileSeriesData));
with FileSeriesData do
begin
AddSeries(PlotName, PlotColor, PlotStyle);
SetLimits(XMin, XMax, YMin, YMax, XScale, YScale, SeriesNumber);
end;
end;
end;
FileClose(iFileHandle);
end;
{-------------------------
procedure TRtChart.PlotCsvExport(Fil
var
SaveDialog: TSaveDialog;
I, J: Integer;
ExportCsvFile: TextFile;
begin
if FItems > 0 then { can't export nothing! }
begin
{ setup the save file dialog }
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.Filter := 'Chart file (*.scd)|*.scd';
SaveDialog.FileName := 'Chart';
SaveDialog.Title := 'Save Chart As ';
SaveDialog.DefaultExt := 'xxx';
SaveDialog.Options := [ofOverwritePrompt];
if SaveDialog.Execute then { if user selected a file }
begin
AssignFile(ExportCsvFile,S
ReWrite(ExportCsvFile);
try
Write(ExportCsvFile,FData[
{ write all of the plot names }
for I:= Low(FData) to High(FData) do Write(ExportCsvFile,FData[
Writeln(ExportCsvFile);
Write(ExportCsvFile,'X');{
{ write Y for each series }
for I:= Low(FData) to High(FData) do Write(ExportCsvFile,',Y');
Writeln(ExportCsvFile);
{ write all points comma seperated }
for I:= 1 to FData[1].Count do
begin
Write(ExportCsvFile,FloatT
for J:= Low(FData) to High(FData) do
Write(ExportCsvFile,FloatT
Writeln(ExportCsvFile);
end;
finally
CloseFile(ExportCsvFile);
end;
SaveDialog.Free;
end;
end
else Application.MessageBox('No
end;
{-------------------------
procedure TRtChart.PlotExcelExport;
var
frmExport : TfrmExport;
begin
if FItems > 0 then { can't export nothing! }
begin
frmExport := TfrmExport.CreateWithChart
frmExport.Show;
frmExport.DoExport;
frmExport.Free;
end
else Application.MessageBox('No
end;
{-------------------------
procedure TRtChart.AutoScaleClick(Se
var
NewXMin, NewXMax : Single;
NewYMin, NewYMax : Single;
I, J : Integer;
begin
Cursor := crHourGlass;
if (FItems > 0) and (FData[0].Count > 1) then
begin
with FData[0] do
begin
NewXMin := GetX(0) * XScale;
NewXMax := GetX(0) * XScale;
NewYMin := GetY(0) * YScale;
NewYMax := GetY(0) * YScale;
end;
for I := Low(FData) to High(FData) do
begin
for J := 0 to FData[I].Count do
begin
with FData[I] do
begin
if (GetX(J) * XScale) > NewXMax then NewXMax := GetX(J) * XScale;
if (GetX(J) * XScale) < NewXMin then NewXMin := GetX(J) * XScale;
if (GetY(J) * YScale) > NewYMax then NewYMax := GetY(J) * YScale;
if (GetY(J) * YScale) < NewYMin then NewYMin := GetY(J) * YScale;
end;
end;
end;
FXAxis.OnChange := nil;
FYAxis.OnChange := nil;
FXAxis.Max := NewXMax;
FXAxis.Min := NewXMin;
FYAxis.Max := NewYMax;
FYAxis.Min := NewYMin;
FOld.X.Max := NewXMax;
FOld.X.Min := NewXMin;
FOld.Y.Max := NewYMax;
FOld.Y.Min := NewYMin;
FXAxis.OnChange := AxisChanged;
FYAxis.OnChange := AxisChanged;
ReSizePlot(Owner);
Paint;
end;
end;
{-------------------------
procedure TRtChart.ShowMarkerCoord(A
var
UpperMarkerImage, LowerMarkerImage, XYMarkerImage: TBitMap;
GradX, GradY: Single;
TmpStr: String;
begin
FMarker.Canvas.Brush.Color
FMarker.Canvas.Font.Color := clBlack;
if not AWhichMarker then
begin
UpperMarkerImage := TBitmap.Create;
UpperMarkerImage.LoadFromR
UpperMarkerImage.Transpare
FMarker.Canvas.Draw(2, 0, UpperMarkerImage);
UpperMarkerImage.Free;
TmpStr := 'X: ' + FormatFloat('0.00',AX) + ' Y: ' + FormatFloat('0.00',AY);
FMarker.Canvas.Textout(18,
end;
if AWhichMarker then
begin
LowerMarkerImage := TBitmap.Create;
LowerMarkerImage.LoadFromR
LowerMarkerImage.Transpare
FMarker.Canvas.Draw(2, 16, LowerMarkerImage);
LowerMarkerImage.Free;
TmpStr := 'X: ' + FormatFloat('0.00',AX) + ' Y: ' + FormatFloat('0.00',AY);
FMarker.Canvas.Textout(18,
end;
XYMarkerImage := TBitmap.Create;
XYMarkerImage.LoadFromReso
XYMarkerImage.Transparent := True;
FMarker.Canvas.Draw(Round(
XYMarkerImage.Free;
GradX := FData[FMarker.DataIdx].Get
GradX := GradX - FData[FMarker.DataIdx].Get
GradY := FData[FMarker.DataIdx].Get
GradY := GradY - FData[FMarker.DataIdx].Get
with FMarker.Canvas do
begin
TmpStr := 'X: '+ FormatFloat('0.00',GradX) + ' Y: ' + FormatFloat('0.00',GradY);
Textout(Round(Width / 2) + 34, 0, TmpStr + ' ');
Textout(Round(Width / 2), 16, 'Name:');
Pen.Width := 5;
Pen.Color := FData[FMarker.DataIdx].Plo
MoveTo(PenPos.X + 4, PenPos.Y + 5);
LineTo(PenPos.X + 24, PenPos.Y);
TextOut(PenPos.X + 4, PenPos.Y - 5, FData[FMarker.DataIdx].Plo
Pen.Width := 1;
end;
end;
{-------------------------
procedure TRtChart.LinGradFit;
var
I, n, LowerIndex, UpperIndex: Integer;
SumX, SumY, SumX2, SumXY, M, C: Single;
NewXMin, NewXMax, XInc: Single;
AlReadyDone: Boolean;
begin
SumX := 0;
SumY := 0;
SumX2 := 0;
SumXY := 0;
AlReadyDone := False;
{ do not redo gradient fit is already done }
for I:= Low(FData) to High(FData) do
if FData[I].PlotName = 'Gradient Fit' then AlReadyDone := True;
if not AlReadyDone and FPopUpItems[ChartMarker].C
begin
if FMarker.Lower.Idx > FMarker.Upper.Idx then
begin
LowerIndex := FMarker.Upper.Idx;
UpperIndex := FMarker.Lower.Idx;
end
else
begin
LowerIndex := FMarker.Lower.Idx;
UpperIndex := FMarker.Upper.Idx;
end;
n := UpperIndex - LowerIndex+1;
for I:= LowerIndex to UpperIndex do
begin
SumX := SumX + FData[FMarker.DataIdx].Get
SumY := SumY + FData[FMarker.DataIdx].Get
SumX2 := SumX2 + Sqr(FData[FMarker.DataIdx]
SumXY := SumXY + FData[FMarker.DataIdx].Get
end;
M := ((SumXY / SumX)-(SumY / n)) / ((SumX2 / SumX) - (SumX / n));
C := (SumY / n) - ((SumX / n) * M);
NewXMin := FData[FMarker.DataIdx].Get
NewXMin := NewXMin / 1.1; { add 10% }
NewXMax := FData[FMarker.DataIdx].Get
NewXMax := NewXMax * 1.1; { add 10% }
XInc := (NewXMax - NewXMin) / n;
AddSeries('Gradient Fit', clWhite, psLines);
While NewXMin < NewXMax do
begin
Add(NewXMin,M * NewXMin + C, FItems - 1);
NewXMin := NewXMin + XInc;
end;
end;
end;
{-------------------------
procedure TRtChart.RemoveLinGradFit;
begin
ReMoveSeries('Gradient Fit');
end;
{-------------------------
procedure TRtChart.AxisChanged(Sende
begin
ReSizePlot(Owner);
Paint;
end;
{-------------------------
procedure TRtChart.MoveValiDateXY(AD
var
M, C: Single;
begin
if AMoveX < 0 then { calculate new start point if gone over Left axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M*AMoveX);
AMoveX := 0;
AMoveY := (M*AMoveX) + C;
end;
if AMoveX > FPlotArea.Right - FPlotArea.Left then { calculate new start point if gone over right axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveX := FPlotArea.Right - FPlotArea.Left;
AMoveY := (M*AMoveX) + C;
end;
if AMoveY < 0 then { calculate new start point if gone over top axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveY := 0;
{ check for possible divide by zero error }
if M = 0 then AMoveX := (AMoveY - C) else AMoveX := (AMoveY - C) / M;
end;
if AMoveY > FPlotArea.Bottom then { calculate new start point if gone over Bottom axis }
begin
{ check for possible divide by zero error }
if (ADrawX - AMoveX) = 0 then M := ADrawY - AMoveY
else M := (ADrawY - AMoveY) / (ADrawX - AMoveX);
C := AMoveY - (M * AMoveX);
AMoveY := FPlotArea.Bottom;
{ check for possible divide by zero error }
if M = 0 then AMoveX := (AMoveY - C) else AMoveX := (AMoveY - C) / M;
end;
{ if still out of the limits adjust }
if AMoveX < 0 then AMoveX := 0;
if AMoveX > FPlotArea.Right - FPlotArea.Left then AMoveX := FPlotArea.Right - FPlotArea.Left;
if AMoveY < 0 then AMoveY := 0;
if AMoveY > FPlotArea.Bottom then AMoveY := FPlotArea.Bottom;
end;
{-------------------------
{ if plot has gone over plot area chop it off }
procedure TRtChart.DrawValiDateXY(AM
var
M, C: Single;
begin
if ADrawX < 0 then { calculate new plot if gone over Left axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawX := 0;
ADrawY := (M*ADrawX) + C;
end;
if ADrawX > FPlotArea.Right - FPlotArea.Left then { calculate new plot if gone over right axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawX := FPlotArea.Right - FPlotArea.Left;
ADrawY := (M*ADrawX) + C;
end;
if ADrawY < 0 then { calculate new plot if gone over top axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawY := 0;
ADrawX := (ADrawY-C) / M;
end;
if ADrawY > FPlotArea.Bottom then { calculate new plot if gone over Bottom axis }
begin
{ check for possible divide by zero error }
if (ADrawX-AMoveX) = 0 then M := ADrawY-AMoveY
else M := (ADrawY-AMoveY) / (ADrawX-AMoveX);
C := AMoveY - (M*AMoveX);
ADrawY := FPlotArea.Bottom;
ADrawX := (ADrawY-C) / M;
end;
{ if still out of the limits adjust }
if ADrawX < 0 then ADrawX := 0;
if ADrawX > FPlotArea.Right - FPlotArea.Left then ADrawX := FPlotArea.Right - FPlotArea.Left;
if ADrawY < 0 then ADrawY := 0;
if ADrawY > FPlotArea.Bottom then ADrawY := FPlotArea.Bottom;
end;
{-------------------------
procedure Register;
begin
RegisterComponents('Servoc
end;
{-------------------------
end.
Here is the forms code DunlopTyreAbsorb.pas
unit DunTyreAbsorb;
interface
{*************************
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, inifiles,
CalSet, ComCtrls, StdCtrls, ExtCtrls, Menus, ToolWin, RtChart, ChartExt, ImgList,
ThdTimer, plotOpts, Trips;
{*************************
const
cSp = 50;
cLd = 5000;
cTm = 10;
PltClr: array[1..5] of TColor = (clMaroon, clGreen, clOlive, clNavy, clPurple);
cSbAESK = 1;
cSbSide = 2;
cSbStatus = 3;
cSideName: array [1..2] of String = ('LEFT', 'RIGHT');
cLeft = 1;
cRight = 2;
cLoad = 1;
cPos = 2;
cSpeed = 3;
cLoadDAC = 0;
cSpeedDAC = 1;
cDigInSide = 8;
cDigInReady = 9;
cDigInMode = 10;
cDigInTrip1 = 12;
cDigInTrip2 = 13;
cDigInTrip3 = 14;
cDigInTrip4 = 15;
cDigInTrip5 = 16;
cDigInTrip6 = 17;
cDigInTrip7 = 18;
cDigInTrip8 = 19;
cDigOutLoadPos = 0; { 1 = position, 0 = load }
cDigOutDrumStop = 1; { 1 = stop, 0 = clear }
cDigOutCoast = 2; { 1 = Coast mode, 0 = reconnect }
cAoutLoad = 0;
cAoutSpeed = 1;
type
EConfigFileError = class(Exception);
ENoConfigFile = class(Exception);
EHdrFileError = class(Exception);
ENoHdrFile = class(Exception);
EAchieveFileError = class(Exception);
ENoAchieveFile = class(Exception);
EAESKFileError = class(Exception);
ENoAESKFile = class(Exception);
EUserCancel = class(Exception);
ECalFileError = class(Exception);
ECycleLimit = class(Exception);
ETyreInst = class(Exception);
EAcqCardError = class(Exception);
EAcqMemError = class(Exception);
ESystemNotReady = class(Exception);
ENothingToTest = class(Exception);
ETrip = class(Exception);
{*************************
TCfg = record
Name: String;
Status: Integer;
Path: String;
end;
TConfig = array [1..2] of TCfg;
{*************************
TTest = record
Load: Single;
KE: Single;
Required: Integer;
Achieved: Integer;
TNoLoad: Single;
TLoad: Single;
end;
TTestsDone = array [1..2] of array [1..2] of TTest;
{*************************
TKEFLy = record
High: Single;
Low: Single;
end;
{*************************
TfrmTyreAbsorb = class(TForm)
mmMain: TMainMenu;
SB: TStatusBar;
mmiSelect: TMenuItem;
mmiExit: TMenuItem;
NB: TNotebook;
gbLeft: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
pnlLMachTest: TPanel;
pnlLOrderNum: TPanel;
pnlLTyreSize: TPanel;
lvLeft: TListView;
gbRight: TGroupBox;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
pnlRMachTest: TPanel;
pnlROrderNum: TPanel;
pnlRTyreSize: TPanel;
lvRight: TListView;
Chart: TRtChart;
IL: TImageList;
mmiFile: TMenuItem;
mmiTyre: TMenuItem;
mmiInstall: TMenuItem;
mmiRemove: TMenuItem;
Tools1: TMenuItem;
ttmrAcqIn: TThreadedTimer;
mmiStop: TMenuItem;
mmiStart: TMenuItem;
tmrStopTest: TTimer;
mmiPlotOptions: TMenuItem;
mmiview: TMenuItem;
mmiSetup: TMenuItem;
mmiChart: TMenuItem;
N1: TMenuItem;
mmiPrint: TMenuItem;
N2: TMenuItem;
mmiNew: TMenuItem;
mmiopen: TMenuItem;
odOpen: TOpenDialog;
sdNew: TSaveDialog;
mmiAbout: TMenuItem;
N4: TMenuItem;
mmiReport: TMenuItem;
CB: TControlBar;
tlbMain: TToolBar;
tbNew: TToolButton;
tbOpen: TToolButton;
tbPrint: TToolButton;
ToolButton4: TToolButton;
tbSetup: TToolButton;
tbChart: TToolButton;
tlbTrips: TToolBar;
tbTrip1: TToolButton;
tbTrip2: TToolButton;
tbTrip3: TToolButton;
tbTrip4: TToolButton;
tbTrip5: TToolButton;
tbTrip6: TToolButton;
tbTrip7: TToolButton;
tbTrip8: TToolButton;
ToolButton1: TToolButton;
tbStop: TToolButton;
mmiTrips: TMenuItem;
mmiHelp: TMenuItem;
pnlMeter: TPanel;
lblTime: TLabel;
lblLoad: TLabel;
lblSpeed: TLabel;
N3: TMenuItem;
mmiResults: TMenuItem;
N5: TMenuItem;
mmiCoast: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure mmiStartClick(Sender: TObject);
procedure tbSetupClick(Sender: TObject);
procedure tbChartClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure mmiExitClick(Sender: TObject);
procedure mmiRemoveClick(Sender: TObject);
procedure mmiInstallClick(Sender: TObject);
procedure ttmrAcqInTimer(Sender: TObject);
procedure mmiStopClick(Sender: TObject);
procedure LVSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
procedure tmrStopTestTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure mmiPlotOptionsClick(Sender
procedure mmiPrintClick(Sender: TObject);
procedure mmiNewClick(Sender: TObject);
procedure mmiopenClick(Sender: TObject);
procedure mmiAboutClick(Sender: TObject);
procedure mmiReportClick(Sender: TObject);
procedure mmiTripsClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure mmiResultsClick(Sender: TObject);
procedure mmiCoastClick(Sender: TObject);
private
FCalib: TCalibSetting;
FErrCode: byte;
FConfig: TConfig;
FWhichSide: byte;
FActiveSide: byte;
FTestsDone: TTestsDone;
FCalData: TChannel;
FStartTestLoad: Single;
TY: array [1..2,1..15] of String;
QY: array [1..2,1..7] of String;
FAcqErr: Integer;
FAcqData: array [0..8] of Double;
FMemHnd: Integer;
FDigOutVal: Word;
FUserStop: Boolean;
FStartTime: TDateTime;
FOldTime: Double;
FStartTest: Boolean;
FfrmPlotOpt: TfrmPlotOpt;
FfrmTrips: TfrmTrips;
FLeftOffset: Single;
FRightOffset: Single;
FSpeedOffset: Single;
FSysNotReadyCntr: Integer;
FKEFLy: TKEFLy;
FTargetTime: Single;
FCoastType: Byte;
FCoasting: Boolean;
function GetSpeed: Single;
function SetSpeed(Speed: Single): Boolean;
function GetLoad: Single;
function SetLoad(Load: Single): Boolean;
function GetPosition: Single;
procedure ReadConfigFile;
procedure SaveConfigFile;
procedure ReadHeader(FileName: String);
procedure SaveHeader(FileName: String);
procedure ReadAchieved(FileName: String);
procedure SaveAchieved(FileName: String);
procedure SetSide(WhichSide: byte);
procedure DisplayHeader(WhichSide: Byte);
procedure DisableSide(WhichSide: byte);
procedure EnableSide(WhichSide: byte);
procedure CommandReset;
procedure CheckDrum(SpeedTarget: Single);
function DoTouchLoad: Single;
procedure TyreStop;
procedure SaveData;
procedure ReadyToStart;
procedure DoError(ErrNo: Integer);
procedure NewTest;
procedure OpenTest;
procedure DisableAll;
procedure EnableAll;
procedure MyHint(Sender: TObject);
procedure ReadTrips;
procedure SaveTrips;
procedure CheckTrips;
end;
{*************************
var
frmTyreAbsorb: TfrmTyreAbsorb;
implementation
uses TouchLoad, SaveTest, TestResult, InstallTyre, Cbw, Status, New, AboutBox, TestReport,
Coast;
{$R *.DFM}
{*************************
procedure TfrmTyreAbsorb.FormCreate(
var
RevLevel: Single;
DigInVal: SmallInt;
begin
LblTime.Caption := 'Time: 0 Secs';
FUserStop := False;
FErrCode := 0;
Chart.XAxis.Min := 0;
Chart.YAxis.Min := 0;
Chart.Y2Axis.min := 0;
FSysNotReadyCntr := 0;
FCoastType := 0;
nb.ActivePage := 'Test';
Application.OnHint := MyHint;
FfrmPlotOpt := TfrmPlotOpt.Create(Self);
FfrmTrips := TfrmTrips.Create(Self);
try
RevLevel := CURRENTREVNUM; { setup AcqCard }
FAcqErr := cbDeclareRevision(RevLevel
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbErrHandling(DONTPRINT, DONTSTOP);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTA, DIGITALOUT);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTB, DIGITALIN);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbDConfigPort(0, FIRSTPORTCL, DIGITALIN);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FMemHnd := cbWinBufAlloc(800); { allocate 8 channels of data }
if FMemHnd = 0 then raise EAcqMemError.Create('');
FDigOutVal := 0;
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1); { reset digital out}
if FAcqErr <> 0 then raise EAcqCardError.Create('');
CommandReset;
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInSide, DigInVal); { find which side }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then FActiveSide := cLeft else FActiveSide := cRight;
ReadConfigFile;
if FConfig[cLeft].Status > 0 then SetSide(cLeft);
if FConfig[cRight].Status > 0 then SetSide(cRight);
{ read calibration file }
FCalib := TCalibSetting.Create();
if not FCalib.CalibFileExists(0) then raise ECalFileError.Create('')
else FCalData := FCalib.GetData;
DisplayHeader(cLeft);
DisableSide(cLeft);
DisplayHeader(cRight);
DisableSide(cRight);
DisplayHeader(FActiveSide)
ReadTrips;
FStartTest := False;
FCoasting := False;
ttmrAcqIn.Enabled := True;
except
on EConfigFileError do FErrCode := 1;
on ENoConfigFile do FErrCode := 2;
on EHdrFileError do FErrCode := 3;
on ENoHdrFile do FErrCode := 4;
on EAchieveFileError do FErrCode := 5;
on ENoAchieveFile do FErrCode := 6;
on ECalFileError do FErrCode := 7;
on EAcqCardError do FErrCode := 8;
on EAcqMemError do FErrCode := 9;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormDestroy
begin
if FCalib <> nil then FCalib.Free;
if FMemHnd <> 0 then cbWinBufFree(FMemHnd);
FfrmPlotOpt.Free;
FfrmTrips.Free;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormCloseQu
begin
if FStartTest or FCoasting then
CanClose := False else ttmrAcqIn.Enabled := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.SetSide(Whi
begin
FWhichSide := WhichSide;
ReadHeader(FConfig[WhichSi
ReadAchieved(FConfig[Which
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadConfigF
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
FConfig[cLeft].Name := ConfigFile.ReadString('Abs
if FConfig[cLeft].Name = 'ERR' then raise EConfigFileError.Create(''
FConfig[cLeft].Path := ConfigFile.ReadString('Abs
if FConfig[cLeft].Path = 'ERR' then raise EConfigFileError.Create(''
FConfig[cLeft].Status := ConfigFile.ReadInteger('Ab
if FConfig[cLeft].Status = -1 then raise EConfigFileError.Create(''
FConfig[cRight].Name := ConfigFile.ReadString('Abs
if FConfig[cRight].Name = 'ERR' then raise EConfigFileError.Create(''
FConfig[cRight].Path := ConfigFile.ReadString('Abs
if FConfig[cRight].Path = 'ERR' then raise EConfigFileError.Create(''
FConfig[cRight].Status := ConfigFile.ReadInteger('Ab
if FConfig[cRight].Status = -1 then raise EConfigFileError.Create(''
FLeftOffset := ConfigFile.ReadFloat('Load
if FLeftOffset = -1 then raise EConfigFileError.Create(''
FRightOffset := ConfigFile.ReadFloat('Load
if FRightOffset = -1 then raise EConfigFileError.Create(''
FSpeedOffset := ConfigFile.ReadFloat('Spee
if FSpeedOffset = -1 then raise EConfigFileError.Create(''
FKEFly.High := ConfigFile.ReadFloat('Flyw
if FKEFly.High = -1 then raise EConfigFileError.Create(''
FKEFly.Low := ConfigFile.ReadFloat('Flyw
if FKEFly.Low = -1 then raise EConfigFileError.Create(''
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveConfigF
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
ConfigFile.WriteString('Ab
ConfigFile.WriteString('Ab
ConfigFile.WriteInteger('A
ConfigFile.WriteString('Ab
ConfigFile.WriteString('Ab
ConfigFile.WriteInteger('A
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormShow(Se
procedure ShowError(ATitle: String);
begin
MessageDlg(ATitle, mtError, [mbOk], 0);
Close;
end;
begin
case FErrCode of
0:;
1: ShowError('Config File Error');
2: ShowError('No Config File');
3: ShowError('Header File Error');
4: ShowError('No Header File');
5: ShowError('Achieve File Error');
6: ShowError('No Achieve File');
7: ShowError('Main Calibration File Error');
8: ShowError('Acq Error: CODE ' + IntToStr(FAcqErr));
9: ShowError('Unable To Allocate Scan Memory');
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadHeader(
var
TmpStr: String;
HdrFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoHdrFile.Create('');
AssignFile(HdrFile, FileName);
try
try
{ TY stuff }
Reset(HdrFile);
for I := 1 to 15 do
begin
Readln(HdrFile, TmpStr);
Ty[FWhichSide, I] := TmpStr;
end;
{ QY stuff }
for I := 1 to 7 do
begin
Readln(HdrFile, TmpStr);
Qy[FWhichSide, I] := TmpStr;
end;
{ High & Speed params }
for I:= Low(FTestsDone[FWhichSide]
begin
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].Load := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].KE := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].Required := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].TNoLoad := StrToInt(TmpStr);
Readln(HdrFile, TmpStr);
FTestsDone[FWhichSide, I].TLoad := StrToInt(TmpStr);
end;
except
on Exception do raise EHdrFileError.Create('');
end;
finally
CloseFile(HdrFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveHeader(
var
HdrFile: TextFile;
I, WS: Integer;
begin
if not FileExists(FileName) then raise ENoHdrFile.Create('');
AssignFile(HdrFile, FileName);
try
try
WS := FWhichSide;
Rewrite(HdrFile);
for I := Low(Ty[WS]) to High(Ty[WS]) do Writeln(HdrFile, Ty[WS, I]);
for I := Low(Qy[WS]) to High(Qy[WS]) do Writeln(HdrFile, Qy[WS, I]);
for I:= Low(FTestsDone[WS]) to High(FTestsDone[WS]) do
begin
Writeln(HdrFile, Round(FTestsDone[WS, I].Load));
Writeln(HdrFile, Round(FTestsDone[WS, I].KE));
Writeln(HdrFile, Round(FTestsDone[WS, I].Required));
Writeln(HdrFile, Round(FTestsDone[WS, I].TNoLoad));
Writeln(HdrFile, Round(FTestsDone[WS, I].TLoad));
end;
except
on Exception do raise EHdrFileError.Create('');
end;
finally
CloseFile(HdrFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadAchieve
var
TmpStr: String;
AchFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoAchieveFile.Create('');
AssignFile(AchFile, FileName);
try
try
Reset(AchFile);
for I:= Low(FTestsDone[FWhichSide]
begin
Readln(AchFile, TmpStr);
FTestsDone[FWhichSide, I].Achieved := StrToInt(TmpStr);
end;
except
on Exception do raise EAchieveFileError.Create('
end;
finally
CloseFile(AchFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveAchieve
var
AchFile: TextFile;
I: Integer;
begin
if not FileExists(FileName) then raise ENoAchieveFile.Create('');
AssignFile(AchFile, FileName);
try
try
ReWrite(AchFile);
{ first line is the number of AESK's }
for I:= Low(FTestsDone[FWhichSide]
Writeln(AchFile, IntToStr(FTestsDone[FWhich
except
on Exception do raise EAchieveFileError.Create('
end;
finally
CloseFile(AchFile);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.DisplayHead
var
ListItem: TListItem;
ListView: TListView;
MachTest, OrderNum, TyreSize: TPanel;
CalSettings: TSettings;
begin
if FConfig[WhichSide].Status = 0 then DisableSide(WhichSide) else EnableSide(WhichSide);
{ get right scale and offset for the selected side }
if FActiveSide = WhichSide then
begin
sb.Panels.Items[cSbSide].T
CalSettings := FCalib.GetSettings;
CalSettings.Machine := WhichSide;
FCalib.SetSettings(CalSett
FCalData := FCalib.GetData;
end;
if WhichSide = cLeft then
begin
MachTest := pnlLMachTest;
OrderNum := pnlLOrderNum;
TyreSize := pnlLTyreSize;
ListView := lvLeft;
end
else begin
MachTest := pnlRMachTest;
OrderNum := pnlROrderNum;
TyreSize := pnlRTyreSize;
ListView := lvRight;
end;
MachTest.Caption := ' ' + TY[WhichSide, 2];
OrderNum.Caption := ' ' + TY[WhichSide, 4];
TyreSize.Caption := ' ' + TY[WhichSide, 6];
ListView.Items.Clear;
ListItem := ListView.Items.Add;
ListItem.Caption := 'High Speed';
ListItem.SubItems.Add(IntT
ListItem.SubItems.Add(IntT
ListItem := ListView.Items.Add;
ListItem.Caption := 'Low Speed';
ListItem.SubItems.Add(IntT
ListItem.SubItems.Add(IntT
end;
{-------------------------
procedure TfrmTyreAbsorb.DisableSide
var
I: Integer;
begin
case WhichSide of
cLeft: for I := 0 to gbLeft.ControlCount - 1 do gbLeft.Controls[I].Enabled
cRight: for I := 0 to gbRight.ControlCount - 1 do gbRight.Controls[I].Enable
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.EnableSide(
var
I: Integer;
begin
case WhichSide of
cLeft: for I := 0 to gbLeft.ControlCount - 1 do gbLeft.Controls[I].Enabled
cRight: for I := 0 to gbRight.ControlCount - 1 do gbRight.Controls[I].Enable
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiStartCli
var
Load, Speed: Single;
I: Integer;
LV: TListView;
TestName: String;
begin
SB.Panels.Items[cSbStatus]
FSysNotReadyCntr := 0;
ttmrAcqIn.Enabled := True;
try
CheckTrips;
if FActiveSide = 1 then LV := lvLeft else LV := lvRight;
if LV.Selected = nil then raise ENothingToTest.Create('');
if LV.Selected.SubItems.Strin
raise ECycleLimit.Create('');
TestName := LV.Selected.Caption;
DisableAll;
Chart.ClearAll;
tbChart.Down := True;
mmiChart.Checked := True;
mmiSetup.Checked := False;
NB.ActivePage := 'Chart';
ReadyToStart;
CommandReset;
if TestName = 'High Speed' then Speed := 120 else Speed := 90;
// if TestName = 'High Speed' then Speed := 0 else Speed := 0;
CheckDrum(Speed);
{ ramp to start load }
if FCoastType < 2 then { 2 being without load }
begin
Load := DoTouchLoad;
if TestName = 'High Speed' then I := 1 else I := 2;
while Load < FTestsDone[FActiveSide, I].Load do
begin
if not SetLoad(Load) then raise EAcqCardError.Create('');
if not SetSpeed(Speed) then raise EAcqCardError.Create('');
Load := Load + 0.1;
end;
end;
Sleep(2000);
{ coast mode }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FStartTime := Now;
FOldTime := 0.01;
if FCoastType = 0 then FStartTest := True else FCoasting := True;
except
on EUserCancel do DoError(1);
on EAcqCardError do DoError(2);
on EConfigFileError do DoError(3);
on ENoConfigFile do DoError(4);
on ECycleLimit do DoError(5);
on ENothingToTest do DoError(6);
on ETrip do MessageDlg('Can not start test on critical trip', mtError, [mbOk], 0);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.tbSetupClic
begin
nb.ActivePage := 'Test';
tbSetup.Down := True;
mmiSetup.Checked := True;
mmiChart.Checked := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.tbChartClic
begin
nb.ActivePage := 'Chart';
tbChart.Down := True;
mmiSetup.Checked := False;
mmiChart.Checked := True;
end;
{-------------------------
procedure TfrmTyreAbsorb.CommandRese
begin
{ Coast mode }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Sleep(100);
{ position control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
{ drum stop }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
{ reset DAC's }
FAcqErr := cbAOut(0, cSpeedDAC, BIP10VOLTS, $7FFF); { 0 Volts }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, $7FFF); { 0 Volts }
if FAcqErr <> 0 then raise EAcqCardError.Create('');
end;
{-------------------------
procedure TfrmTyreAbsorb.CheckDrum(S
var
Speed: Single;
begin
if GetSpeed < 4.2 then SB.Panels.Items[cSbStatus]
if not SetSpeed(5) then raise EAcqCardError.Create('');
repeat
Speed := GetSpeed;
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed > 3;
if not SetSpeed(SpeedTarget) then raise EAcqCardError.Create('');
repeat
Speed := GetSpeed;
SB.Panels.Items[cSbStatus]
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed > SpeedTarget - 2;
SB.Panels.Items[cSbStatus]
end;
{-------------------------
function TfrmTyreAbsorb.GetSpeed: Single;
var
ADCValue: Double;
Scale, Offset: Double;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[3];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cSpeed].Scal
Offset := FCalData.Chan[cSpeed].Offs
Result := ADCValue * Scale + Offset;
end;
{-------------------------
function TfrmTyreAbsorb.SetSpeed(Sp
var
AoutSpeed: Word;
MaxSpeed, Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
Result := False;
Speed := Speed + FSpeedOffset;
if Speed > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
Scale := FCalData.Chan[cSpeed].Scal
Offset := FCalData.Chan[cSpeed].Offs
MaxSpeed := $7FFF * Scale + Offset;
if Speed >= 0 then AoutSpeed := Round(($7FFF/ MaxSpeed) * Speed) + $7FFF
else AoutSpeed := Round(($7FFF/ MaxSpeed) * Speed);
FAcqErr := cbAOut(0, cAoutSpeed, BIP10VOLTS, AoutSpeed); { Ouput SpeedTarget on DAC }
if FAcqErr <> 0 then exit;
Result := True;
end;
{-------------------------
function TfrmTyreAbsorb.DoTouchLoad
var
DispMoveMax, Load, LoadPeak, Position, CurTime, TouchLoad: Single;
Rate, Command, I: Integer;
frmTouchLoad: TfrmTouchLoad;
Time: TDateTime;
Hour, Min, Sec, MSec: Word;
FileName: String;
ConfigFile: TIniFile;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
DispMoveMax := ConfigFile.ReadInteger('To
if DispMoveMax < 0 then raise EConfigFileError.Create(''
TouchLoad := ConfigFile.ReadInteger('To
if TouchLoad < 0 then raise EConfigFileError.Create(''
Rate := ConfigFile.ReadInteger('To
if Rate < 0 then raise EConfigFileError.Create(''
ConfigFile.Free;
LoadPeak := 0;
frmTouchLoad := TfrmTouchLoad.Create(Self)
try
frmTouchLoad.Show;
Command := Rate;
Time := Now;
{ in position control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 1);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
repeat // start Actuator moving
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, Command);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Load := GetLoad;
frmTouchLoad.lblLoadValue.
FCalData.Chan[cLoad].Units
if Load > LoadPeak then LoadPeak := Load;
Position := GetPosition;
frmTouchLoad.lblPositionVa
FCalData.Chan[cPos].Units;
Inc(Command);
DecodeTime(Now - Time, Hour, Min, Sec, MSec);
CurTime := (Hour * 60 * 60) * (Min * 60) + Sec + (MSec /1000);
frmTouchLoad.lblTimeValue.
for I := 1 to 5000 do
begin
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
if frmTouchLoad.ModalResult = mrCancel then raise EUserCancel.Create('');
end;
until Position > DispMoveMax;
TouchLoad := LoadPeak + TouchLoad;
repeat // move actuator until touch load seen
FAcqErr := cbAOut(0, cLoadDAC, BIP10VOLTS, Command);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Load := GetLoad;
frmTouchLoad.lblLoadValue.
FCalData.Chan[cLoad].Units
Position := GetPosition;
frmTouchLoad.lblPositionVa
FCalData.Chan[cPos].Units;
Inc(Command);
DecodeTime(Now - Time, Hour, Min, Sec, MSec);
CurTime := (Hour * 60 * 60) * (Min * 60) + Sec + (MSec /1000);
frmTouchLoad.lblTimeValue.
for I := 1 to 5000 do
begin
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
if frmTouchLoad.ModalResult = mrCancel then raise EUserCancel.Create('');
end;
until Load > TouchLoad;
TouchLoad := Load;
if not SetLoad(TouchLoad) then EAcqCardError.Create('');
{ in load control }
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
finally
frmTouchLoad.Free;
Result := TouchLoad;
end;
end;
{-------------------------
function TfrmTyreAbsorb.GetLoad: Single;
var
ADCValue: Double;
Scale, Offset: Double;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[1];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cLoad].Scale
Offset := FCalData.Chan[cLoad].Offse
Result := ADCValue * Scale + Offset;
end;
{-------------------------
function TfrmTyreAbsorb.SetLoad(Loa
var
AoutLoad: Word;
MaxLoad, Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
Result := False;
if FActiveSide = cLeft then Load := Load + FLeftOffset
else Load := Load + FRightOffset;
if Load > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
Scale := FCalData.Chan[cLoad].Scale
Offset := FCalData.Chan[cLoad].Offse
MaxLoad := $7FFF * Scale + Offset;
if Load >= 0 then AoutLoad := Round(($7FFF/ MaxLoad) * Load) + $7FFF
else AoutLoad := Round(($7FFF/ MaxLoad) * Load);
FAcqErr := cbAOut(0, cAoutLoad, BIP10VOLTS, AoutLoad); { Ouput LoadTarget on DAC }
if FAcqErr <> 0 then exit;
Result := True;
end;
{-------------------------
function TfrmTyreAbsorb.GetPosition
var
ADCValue: Double;
Scale, Offset: Single;
WhichScaleOffset: Byte;
begin
if not ttmrAcqIn.Enabled and (FAcqErr <> 0) then raise EAcqCardError.Create('');
ADCValue := FAcqData[2];
if ADCValue > 0 then WhichScaleOffset := 1 else WhichScaleOffset := 2;
if ADCValue <= 0 then ADCValue := ADCValue * -1;
Scale := FCalData.Chan[cPos].Scale[
Offset := FCalData.Chan[cPos].Offset
Result := ADCValue * Scale + Offset;
end;
{-------------------------
procedure TfrmTyreAbsorb.TyreStop;
var
Speed, AvgSpeed: Single;
Cntr, TimeStart: DWORD;
begin
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
Sleep(100);
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 1);
if FAcqErr <> 0 then EAcqCardError.Create('');
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutLoadPos, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
if not SetLoad(FStartTestLoad) then EAcqCardError.Create('');
if not SetSpeed(0) then EAcqCardError.Create('');
repeat
TimeStart := GetTickCount + 1000;
Cntr := 0;
AvgSpeed := 0;
repeat
AvgSpeed := AvgSpeed + GetSpeed;
Inc(Cntr);
until GetTickCount > TimeStart;
Speed := AvgSpeed / Cntr;
SB.Panels.Items[cSbStatus]
Application.ProcessMessage
if FUserStop then raise EUserCancel.Create('');
until Speed < 3;
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutDrumStop, 0);
if FAcqErr <> 0 then EAcqCardError.Create('');
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveData;
var
frmSaveTemp: TfrmSaveTemp;
Dir, FileName: String;
I: Integer;
DatFile: TIniFile;
begin
frmSaveTemp := TfrmSaveTemp.Create(Self);
try
if frmSaveTemp.ShowModal = mrYes then
begin
Dir := 'Err';
if SB.Panels[cSBAESK].Text = '' then
begin
MessageDlg('Can not save data', mtError, [mbOk], 0);
Exit;
end;
if SB.Panels[cSBAESK].Text = 'Low Speed' then I := 2 else I := 1;
Dir := FConfig[FActiveSide].Path + SB.Panels[cSBAESK].Text + '-';
Inc(FTestsDone[FActiveSide
SaveAchieved(FConfig[FActi
DisplayHeader(FActiveSide)
Dir := Dir + IntToStr(FTestsDone[FActiv
Exit;
if Dir = 'Err' then raise Exception.Create('Error creating result directory');
if not CreateDir(Dir) then raise Exception.Create('Error creating result directory');
FileName := Dir + '\' + ExtractFileName(Dir) + '.abs';
DatFile := TIniFile.Create(FileName);
DatFile.WriteDate('Test', 'Date', Now);
DatFile.WriteTime('Test', 'Time', Now);
DatFile.WriteString('Test'
for I := 0 to frmSaveTemp.memComments.Li
DatFile.WriteString('Test'
frmSaveTemp.memComments.Li
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.WriteFloat('Test',
DatFile.Free;
end;
finally
frmSaveTemp.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiExitClic
begin
Close;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiRemoveCl
const
cNoTyre = 'No tyre to remove';
var
DocFile: TiniFile;
FileName: String;
ListView: TListView;
MachTest, OrderNum, TyreSize: TPanel;
frmTestResult: TfrmTestResult;
begin
if FConfig[FActiveSide].Statu
else begin
FileName := FConfig[FActiveSide].Path + FConfig[FActiveSide].Name + '.ARS';
DocFile := TiniFile.Create(FileName);
frmTestResult := TfrmTestResult.Create(Self
if frmTestResult.ShowModal = mrOk then
begin
DocFile.WriteString('Test'
DocFile.WriteString('Date'
frmTestResult.Free;
DocFile.Free;
FConfig[FActiveSide].Statu
SaveConfigFile;
DisableSide(FActiveSide);
if FActiveSide = cLeft then
begin
MachTest := pnlLMachTest;
OrderNum := pnlLOrderNum;
TyreSize := pnlLTyreSize;
ListView := lvLeft;
end
else begin
MachTest := pnlRMachTest;
OrderNum := pnlROrderNum;
TyreSize := pnlRTyreSize;
ListView := lvRight;
end;
MachTest.Caption := '';
OrderNum.Caption := '';
TyreSize.Caption := '';
ListView.Items.Clear;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiInstallC
const
cTyreInst = 'Tyre already installed';
cNoHdr = 'No Header File';
cHdrErr = 'Header File Error';
cAchErr = 'Achieve File Error';
cNoAch = 'No Achieve File';
cCfgErr = 'Saving config file error';
var
frmInstallTyre: TfrmInstallTyre;
begin
try
if FConfig[FActiveSide].Statu
odOpen.Title := 'Install Tyre';
if odOpen.Execute then
begin
FWhichSide := FActiveSide;
ReadHeader(odOpen.FileName
ReadAchieved(ChangeFileExt
Ty[1, 7] := 'HS3';
Ty[2, 7] := 'HS4';
frmInstallTyre := TfrmInstallTyre.CreateWith
try
if frmInstallTyre.ShowModal = mrOk then
begin
FConfig[FWhichSide].Path := ExtractFilePath(odOpen.Fil
ChangeFileExt(odOpen.FileN
FConfig[FWhichSide].Name := ChangeFileExt(ExtractFileN
FConfig[FWhichSide].Status
SaveConfigFile;
DisplayHeader(FWhichSide);
SaveHeader(odOpen.FileName
SaveAchieved(ChangeFileExt
end;
finally
frmInstallTyre.Free;
end;
end;
except
on ETyreInst do MessageDlg(cTyreInst, mtError, [mbOk], 0);
on EHdrFileError do MessageDlg(cHdrErr, mtError, [mbOk], 0);
on ENoHdrFile do MessageDlg(cNoHdr, mtError, [mbOk], 0);
on EAchieveFileError do MessageDlg(cAchErr, mtError, [mbOk], 0);
on ENoAchieveFile do MessageDlg(cNoHdr, mtError, [mbOk], 0);
on EConfigFileError do begin
MessageDlg(cCfgErr, mtError, [mbOk], 0);
FConfig[FWhichSide].Status
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadyToStar
var
frmStatus: TfrmStatus;
begin
frmStatus := TfrmStatus.Create(Self);
try
if frmStatus.ShowModal = mrCancel then raise EUserCancel.Create('');
if frmStatus.GetAcqErr <> 0 then
begin
FAcqErr := frmStatus.GetAcqErr;
raise EAcqCardError.Create('');
end;
finally
frmStatus.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.ttmrAcqInTi
var
Rate: Longint;
ADData: array [1..800] of Word;
I, J: Integer;
Hour, Min, Sec, MSec: Word;
NowTime: Single;
DigInVal: SmallInt;
AValue: Single;
begin
Rate := 10000;
try
{ cbAInScan(BoardNum, LowChan, HighChan, Count, Rate, Gain, MemHandle, Options) }
FAcqErr := cbAInScan (0, 0, 7, 800, Rate, BIP10VOLTS, FMemHnd, CONVERTDATA);
if FAcqErr <> 0 then exit;
{ cbWinBufToArray(MemHandle,
FAcqErr := cbWinBufToArray(FMemHnd, ADData[1], 0, 800);
if FAcqErr <> 0 then exit;
FAcqData[0] := Now;
for I := 1 to 8 do FAcqData[I] := 0;
for I := 0 to 99 do
begin
for J := 1 to 8 do FAcqData[J] := FAcqData[J] + ADData[(8 * I) + J];
end;
for I := 1 to 8 do FAcqData[I] := (FAcqData[I] / 100) - $7FFF;
CheckTrips;
{ update meters }
lblLoad.Caption := 'Load: ' + FormatFloat('0', GetLoad) + ' ' + FCalData.Chan[1].Units;
lblSpeed.Caption := 'Speed: ' + FormatFloat('0', GetSpeed) + ' ' + FCalData.Chan[3].Units;
{ see if test has started }
if FStartTest then
begin
{ check for emergency/user stop, if so stop test }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInReady, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then Inc(FSysNotReadyCntr) else FSysNotReadyCntr := 0;
if FSysNotReadyCntr > 4 then raise ESystemNotReady.Create('')
if FUserStop then raise EUserCancel.Create('');
DecodeTime(FAcqData[0] - FStartTime, Hour, Min, Sec, MSec);
NowTime := (Hour * 60 * 60) + (Min * 60) + Sec + (MSec / 1000);
if NowTime > FTargetTime then TmrStopTest.Enabled := True
else begin
{ add data to chart}
if NowTime > FOldTime then
begin
{ update meters }
lblTime.Caption := 'Time: ' + FormatFloat('#', NowTime) + ' Secs ';
Chart.Add(0, NowTime, 0);
Chart.Add(NowTime, GetLoad, 1);
Chart.Add(NowTime, GetPosition, 2);
Chart.Add(NowTime, GetSpeed, 3);
with FCalData do
begin
for I := 4 to High(Chan) do
begin
if Chan[I].Name <> '' then { must be calibrated }
begin
if FAcqData[I] > 0 then
AValue := FAcqData[I] * Chan[I].Scale[1] + Chan[I].Offset[1]
else AValue := FAcqData[I] * Chan[I].Scale[1] + Chan[I].Offset[1] * -1;
Chart.Add(NowTime, AValue, I);
end;
end;
end;
end;
FOldTime := NowTime;
end;
end; { if FStartTest then }
if FCoasting then
begin
{ check for emergency/user stop, if so stop test }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInReady, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then Inc(FSysNotReadyCntr) else FSysNotReadyCntr := 0;
if FSysNotReadyCntr > 4 then raise ESystemNotReady.Create('')
if FUserStop then raise EUserCancel.Create('');
DecodeTime(FAcqData[0] - FStartTime, Hour, Min, Sec, MSec);
NowTime := (Hour * 60 * 60) + (Min * 60) + Sec + (MSec / 1000);
lblTime.Caption := 'Time: ' + FormatFloat('#', NowTime) + ' Secs ';
if SB.Panels[cSBAESK].Text = 'High Speed' then
if GetSpeed < 90 then tmrStopTest.Enabled := True;
if SB.Panels[cSBAESK].Text = 'Low Speed' then
if GetSpeed < 3 then tmrStopTest.Enabled := True;
end; { if FCoastType > 0 then }
{ if not testing check if side is different then update }
if not FStartTest or not FCoasting then
begin
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInSide, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then DigInVal := cLeft else DigInVal := cRight;
if DigInVal <> FActiveSide then
begin
DisableSide(FActiveSide);
FActiveSide := DigInVal;
DisplayHeader(FActiveSide)
end;
end;
except
on EAcqCardError do ttmrAcqIn.Enabled := False;
on EUserCancel do begin
SB.Panels.Items[cSbStatus]
ttmrAcqIn.Enabled := False;
FStartTest := False;
FCoastType := 0;
FCoasting := False;
CommandReset;
FUserStop := False;
EnableAll;
end;
on ESystemNotReady do begin
SB.Panels.Items[cSbStatus]
ttmrAcqIn.Enabled := False;
CommandReset;
FUserStop := False;
FStartTest := False;
FCoasting := False;
FCoastType := 0;
EnableAll;
FSysNotReadyCntr := 0;
end;
on ETrip do begin
FStartTest := False;
FCoasting := False;
CommandReset;
FUserStop := False;
FCoastType := 0;
EnableAll;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiStopClic
begin
FUserStop := True;
end;
{-------------------------
procedure TfrmTyreAbsorb.LVSelectIte
const
cNoTyre = 'No Tyre Installed';
var
MaxTime, MaxLoad, MaxSpeed, MaxPos, Max, aaa, bbb, ccc, ddd: Single;
I, J: Integer;
begin
if not Selected then exit;
sb.Panels.Items[cSbAESK].T
FWhichSide := FActiveSide;
if FConfig[FWhichSide].Status
try
Chart.ReMoveAll;
if Item.Caption = 'High Speed' then
begin
MaxLoad := (Round(FTestsDone[FActiveS
MaxSpeed := 150;
ccc := FKEFly.High - FKEFly.Low;
ddd := FTestsDone[FActiveSide, 2].TLoad - FTestsDone[FActiveSide, 1].TLoad;
if ddd = 0 then aaa := ccc else aaa := ccc / ddd;
ddd := FTestsDone[FActiveSide, 2].TNoLoad - FTestsDone[FActiveSide, 1].TNoLoad;
if ddd = 0 then bbb := ccc else bbb := ccc / ddd;
if (aaa - bbb) = 0 then FTargetTime := FTestsDone[FActiveSide, 1].KE
else FTargetTime := FTestsDone[FActiveSide, 1].KE / (aaa - bbb);
end
else begin
MaxLoad := (Round(FTestsDone[FActiveS
MaxSpeed := 100;
aaa := FKEFly.Low / FTestsDone[FActiveSide, 2].TLoad;
bbb := FKEFly.Low / FTestsDone[FActiveSide, 2].TNoLoad;
if (aaa - bbb) = 0 then FTargetTime := FTestsDone[FActiveSide, 2].KE
else FTargetTime := FTestsDone[FActiveSide, 2].KE / (aaa - bbb);
end;
MaxTime := (Round(FTargetTime / 10) + 1) * 10;
{ set chart up for Time }
Chart.AddSeries('Time', clYellow, psLines);
Chart.SetLimits(0, MaxTime, 0, 0, 1, 1, 0);
Chart.Items[0].Show := False;
{ set chart up for Load }
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxLoad, 1, 1, cLoad);
Chart.Items[cLoad].Show := FfrmPlotOpt.cbPlot1.Checke
{ set chart up for Position }
MaxPos := $7FFF * FCalData.Chan[cPos].Scale[
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxPos, 1, 1, cPos);
Chart.Items[cPos].Show := FfrmPlotOpt.cbPlot2.Checke
{ set chart up for Speed }
Chart.AddSeries(FCalData.C
Chart.SetLimits(0, MaxTime, 0, MaxSpeed, 1, 1, cSpeed);
Chart.Items[cSpeed].Show := FfrmPlotOpt.cbPlot3.Checke
{ rest of calibrated channels }
for I := 4 to High(FCalData.Chan) do
begin
if FCalData.Chan[I].Name <> '' then { must be calibrated }
begin
Chart.AddSeries(FCalData.C
Max := $7FFF * FCalData.Chan[I].Scale[1] + FCalData.Chan[I].Offset[1]
Chart.SetLimits(0, MaxTime, 0, Max, 1, 1, I);
for J := 0 to FfrmPlotOpt.ControlCount - 1 do
if FfrmPlotOpt.Controls[J].Na
Chart.Items[I].Show := TCheckBox(FfrmPlotOpt.Cont
end;
end;
{ setup ratios for Yaxis default }
for I := 1 to Chart.Count - 1 do
begin
case I of
cLoad, cSpeed: Max := MaxLoad;
else
Max := $7FFF * FCalData.Chan[1].Scale[1] + FCalData.Chan[I].Offset[1]
end;
Chart.Items[I].YScale := Max / Chart.Items[I].YMax;
end;
Chart.XAxis.Title := 'Time';
Chart.XAxis.Min := 0;
Chart.XAxis.Max := MaxTime;
Chart.YAxis.Title := FCalData.Chan[1].Name;
Chart.YAxis.Min := 0;
Chart.YAxis.Max := Chart.Items[1].YMax;
Chart.YAxis.Font.Color := Chart.Items[1].PlotColor;
Chart.Y2Axis.Title := FCalData.Chan[3].Name;
Chart.Y2Axis.Min := 0;
Chart.Y2Axis.Max := Chart.Items[3].YMax;
Chart.Y2Axis.Font.Color := Chart.Items[3].PlotColor;
except
on EAESKFileError do MessageDlg('Error Reading AESK File!', mtError, [mbOk], 0);
on ENoAESKFile do MessageDlg('No AESK File!', mtError, [mbOk], 0);
on ETyreInst do MessageDlg(cNoTyre, mtWarning, [mbOk], 0);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.tmrStopTest
begin
FStartTest := False;
FCoasting := False;
SB.Panels.Items[cSbStatus]
tmrStopTest.Enabled := False;
try
TyreStop;
CommandReset;
if FCoastType = 0 then
begin
if MessageDlg('Save Data?', mtConfirmation, [mbYes,MbNo], 0) = mrYes then SaveData;
end
else begin
FAcqErr := cbDBitOut(0, FIRSTPORTA, cDigOutCoast, 0);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
MessageDlg(lblTime.Caption
end;
lblTime.Caption := 'Time: 0 Secs';
SB.Panels.Items[cSbStatus]
tbSetup.Down := True;
mmiSetup.Checked := True;
mmiChart.Checked := False;
NB.ActivePage := 'Test';
EnableAll;
except
on EUserCancel do DoError(1);
on EAcqCardError do DoError(2);
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiPlotOpti
var
I, J: Integer;
begin
if FConfig[FActiveSide].Statu
begin
MessageDlg('No tyre installed', mtError, [mbOK] ,0);
Abort;
end;
for I := 0 to FfrmPlotOpt.ControlCount - 1 do
if FfrmPlotOpt.Controls[I].Ta
for I := Low(FCalData.Chan) to High(FCalData.Chan) do
begin
if FCalData.Chan[I].Name = '' then break;
for J := 0 to FfrmPlotOpt.ControlCount - 1 do
begin
if FfrmPlotOpt.Controls[J].Na
begin
TLabel(FfrmPlotOpt.Control
FfrmPlotOpt.Controls[J].En
end;
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
if FfrmPlotOpt.Controls[J].Na
FfrmPlotOpt.Controls[J].En
end;
end;
FfrmPlotOpt.ShowModal;
if FActiveSide = cLeft then LVSelectItem(Sender, LVLeft.Selected, True)
else LVSelectItem(Sender, LVRight.Selected, True);
end;
{-------------------------
procedure TfrmTyreAbsorb.DoError(Err
begin
case ErrNo of
1: SB.Panels.Items[cSbStatus]
2: SB.Panels.Items[cSbStatus]
3: SB.Panels.Items[cSbStatus]
4: SB.Panels.Items[cSbStatus]
5: SB.Panels.Items[cSbStatus]
6: SB.Panels.Items[cSbStatus]
7: SB.Panels.Items[cSbStatus]
8: SB.Panels.Items[cSbStatus]
end;
CommandReset;
EnableAll;
FUserStop := False;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiPrintCli
begin
Chart.Print;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiNewClick
begin
if sdNew.Execute then
begin
if UpperCase(ExtractFileExt(s
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.NewTest;
var
frmNewTest: TfrmNewTest;
FileName: String;
NewHdr, NewNum: TextFile;
DocFile: TIniFile;
begin
if FileExists(sdNew.FileName)
begin
MessageDlg('Tyre already defined!', mtError, [mbOk], 0);
exit;
end;
frmNewTest := TfrmNewTest.CreateWithPara
try
frmNewTest.Caption := 'New - ' + ExtractFileName(sdNew.File
if frmNewTest.ShowModal = mrOk then
begin
AssignFile(NewHdr, sdNew.FileName);
ReWrite(NewHdr);
{ TY stuff }
Writeln(NewHdr, ExtractFileName(ChangeFile
Writeln(NewHdr, frmNewTest.edtMachTest.Tex
Writeln(NewHdr, frmNewTest.edtRptNo.Text);
Writeln(NewHdr, frmNewTest.edtOrdNo.Text);
Writeln(NewHdr, frmNewTest.edtWhlNo.Text);
Writeln(NewHdr, frmNewTest.edtSize.Text);
Writeln(NewHdr, frmNewTest.edtTstStat.Text
Writeln(NewHdr, frmNewTest.edtCode.Text);
Writeln(NewHdr, frmNewTest.edtSpacer.Text)
Writeln(NewHdr, frmNewTest.edtSerNo.Text);
Writeln(NewHdr, frmNewTest.edtBearNo.Text)
Writeln(NewHdr, frmNewTest.edtWgt.Text);
Writeln(NewHdr, frmNewTest.edtShaftNo.Text
Writeln(NewHdr, frmNewTest.edtHard.Text);
Writeln(NewHdr, frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
Writeln(NewHdr, frmNewTest.edtTyreSize.Tex
Writeln(NewHdr, frmNewTest.edtTyrePur.Text
Writeln(NewHdr, frmNewTest.edtAirTyp.Text)
Writeln(NewHdr, frmNewTest.edtBasOn.Text);
Writeln(NewHdr, frmNewTest.edtRatLoad.Text
Writeln(NewHdr, frmNewTest.edtRatPress.Tex
Writeln(NewHdr, frmNewTest.edtFlyDia.Text)
{ Test Files }
Writeln(NewHdr, frmNewTest.edtHighLoad.Tex
Writeln(NewHdr, frmNewTest.edtHighKE.Text)
Writeln(NewHdr, frmNewTest.edtHighReq.Text
Writeln(NewHdr, frmNewTest.edtHighTNoLoad.
Writeln(NewHdr, frmNewTest.edtHighTLoad.Te
Writeln(NewHdr, frmNewTest.edtLowLoad.Text
Writeln(NewHdr, frmNewTest.edtLowKE.Text);
Writeln(NewHdr, frmNewTest.edtLowReq.Text)
Writeln(NewHdr, frmNewTest.edtLowTNoLoad.T
Writeln(NewHdr, frmNewTest.edtLowTLoad.Tex
CloseFile(NewHdr);
FileName := ChangeFileExt(sdNew.FileNa
if FileExists(FileName) then exit;
{ cycles achieved }
AssignFile(NewNum, FileName);
ReWrite(NewNum);
Writeln(NewNum, '0');
Writeln(NewNum, '0');
CloseFile(NewNum);
{ write start date }
FileName := ChangeFileExt(sdNew.FileNa
DocFile := TiniFile.Create(FileName);
DocFile.WriteString('Date'
DocFile.Free;
end;
finally
frmNewTest.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiopenClic
begin
OdOpen.Title := 'Open';
if odOpen.Execute then
begin
if UpperCase(ExtractFileExt(o
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.OpenTest;
var
frmNewTest: TfrmNewTest;
TmpStr, FileName: String;
OpenHdr, AchFile: TextFile;
begin
frmNewTest := TfrmNewTest.CreateWithPara
try
AssignFile(OpenHdr, odOpen.FileName);
ReSet(OpenHdr);
{ TY stuff }
ReadLn(OpenHdr, TmpStr);
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtMachTest.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRptNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtOrdNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtWhlNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSize.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTstStat.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtCode.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSpacer.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtSerNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtBearNo.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtWgt.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtShaftNo.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtHard.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTyreSize.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtTyrePur.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtAirTyp.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtBasOn.Text := TmpStr;
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRatLoad.Text
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtRatPress.Tex
ReadLn(OpenHdr, TmpStr);
frmNewTest.edtFlyDia.Text := TmpStr;
{ Test stuff }
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighLoad.Tex
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighKE.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighReq.Text
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighTNoLoad.
Readln(OpenHdr, TmpStr);
frmNewTest.edtHighTLoad.Te
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowLoad.Text
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowKE.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowReq.Text := TmpStr;
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowTNoLoad.T
Readln(OpenHdr, TmpStr);
frmNewTest.edtLowTLoad.Tex
CloseFile(OpenHdr);
{ read acheived so far }
FileName := ChangeFileExt(odOpen.FileN
AssignFile(AchFile, FileName);
Reset(AchFile);
Readln(AchFile, TmpStr);
frmNewTest.edtHighAch.Text
Readln(AchFile, TmpStr);
frmNewTest.edtLowAch.Text := TmpStr;
CloseFile(AchFile);
frmNewTest.Caption := 'Open - ' + ExtractFileName(odOpen.Fil
if frmNewTest.ShowModal = mrOk then
begin
AssignFile(OpenHdr, odOpen.FileName);
ReWrite(OpenHdr);
{ TY stuff }
Writeln(OpenHdr, ExtractFileName(ChangeFile
Writeln(OpenHdr, frmNewTest.edtMachTest.Tex
Writeln(OpenHdr, frmNewTest.edtRptNo.Text);
Writeln(OpenHdr, frmNewTest.edtOrdNo.Text);
Writeln(OpenHdr, frmNewTest.edtWhlNo.Text);
Writeln(OpenHdr, frmNewTest.edtSize.Text);
Writeln(OpenHdr, frmNewTest.edtTstStat.Text
Writeln(OpenHdr, frmNewTest.edtCode.Text);
Writeln(OpenHdr, frmNewTest.edtSpacer.Text)
Writeln(OpenHdr, frmNewTest.edtSerNo.Text);
Writeln(OpenHdr, frmNewTest.edtBearNo.Text)
Writeln(OpenHdr, frmNewTest.edtWgt.Text);
Writeln(OpenHdr, frmNewTest.edtShaftNo.Text
Writeln(OpenHdr, frmNewTest.edtHard.Text);
Writeln(OpenHdr, frmNewTest.edtNeeDepth.Tex
{ QY Stuff }
Writeln(OpenHdr, frmNewTest.edtTyreSize.Tex
Writeln(OpenHdr, frmNewTest.edtTyrePur.Text
Writeln(OpenHdr, frmNewTest.edtAirTyp.Text)
Writeln(OpenHdr, frmNewTest.edtBasOn.Text);
Writeln(OpenHdr, frmNewTest.edtRatLoad.Text
Writeln(OpenHdr, frmNewTest.edtRatPress.Tex
Writeln(OpenHdr, frmNewTest.edtFlyDia.Text)
{ Test Files }
Writeln(OpenHdr, frmNewTest.edtHighLoad.Tex
Writeln(OpenHdr, frmNewTest.edtHighKE.Text)
Writeln(OpenHdr, frmNewTest.edtHighReq.Text
Writeln(OpenHdr, frmNewTest.edtHighTNoLoad.
Writeln(OpenHdr, frmNewTest.edtHighTLoad.Te
Writeln(OpenHdr, frmNewTest.edtLowLoad.Text
Writeln(OpenHdr, frmNewTest.edtLowKE.Text);
Writeln(OpenHdr, frmNewTest.edtLowReq.Text)
Writeln(OpenHdr, frmNewTest.edtLowTNoLoad.T
Writeln(OpenHdr, frmNewTest.edtLowTLoad.Tex
CloseFile(OpenHdr);
{ read acheived so far }
FileName := ChangeFileExt(odOpen.FileN
AssignFile(AchFile, FileName);
ReWrite(AchFile);
Writeln(AchFile, frmNewTest.edtHighAch.Text
Writeln(AchFile, frmNewTest.edtLowAch.Text)
CloseFile(AchFile);
end;
finally
frmNewTest.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiAboutCli
var
frmAboutBox: TfrmAboutBox;
begin
frmAboutBox := TfrmAboutBox.CreateWithCap
frmAboutBox.ShowModal;
frmAboutBox.Free;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiReportCl
var
frmTestReport: TfrmTestReport;
begin
OdOpen.Title := 'Report';
if odOpen.Execute then
begin
frmTestReport := TfrmTestReport.CreateWithP
frmTestReport.Caption := 'Test Report - ' + ExtractFileName(odOpen.Fil
try
if frmTestReport.SetupData then frmTestReport.ShowModal;
finally
frmTestReport.Free
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiTripsCli
begin
FfrmTrips.ShowModal;
SaveTrips;
end;
{-------------------------
procedure TfrmTyreAbsorb.FormResize(
begin
gbRight.Left := Round(NB.Width / 2);
gbRight.Width := NB.Width - gbRight.Left - 8;
gbRight.Height := NB.Height - gbRight.Top - 4;
pnlRMachTest.Width := gbRight.Width - pnlRMachTest.Left - 8;
pnlROrderNum.Width := gbRight.Width - pnlROrderNum.Left - 8;
pnlRTyreSize.Width := gbRight.Width - pnlRTyreSize.Left - 8;
lvRight.Width := gbRight.Width - lvRight.Left - 8;
lvRight.Height := gbRight.Height - lvRight.Top - 8;
gbLeft.Width := Round((NB.Width / 2) - 8);
gbLeft.Height := NB.Height - gbLeft.Top - 4;
pnlLMachTest.Width := gbLeft.Width - pnlLMachTest.Left - 8;
pnlLOrderNum.Width := gbLeft.Width - pnlLOrderNum.Left - 8;
pnlLTyreSize.Width := gbLeft.Width - pnlLTyreSize.Left - 8;
lvLeft.Width := gbLeft.Width - lvLeft.Left - 8;
lvLeft.Height := gbLeft.Height - lvLeft.Top - 8;
end;
{-------------------------
procedure TfrmTyreAbsorb.DisableAll;
var
I: Integer;
begin
for I := 0 to mmMain.Items.Count - 1 do
if mmMain.Items[I].Tag = 0 then mmMain.Items[I].Enabled := False;
for I := 0 to mmiSelect.Count - 1 do
if mmiSelect.Items[I].Tag = 0 then mmiSelect.Items[I].Enabled
for I := 0 to tlbMain.ButtonCount - 1 do
if tlbMain.Buttons[I].Tag = 0 then tlbMain.Buttons[I].Enabled
BorderIcons := [];
end;
{-------------------------
procedure TfrmTyreAbsorb.EnableAll;
var
I: Integer;
begin
for I := 0 to mmMain.Items.Count - 1 do
if mmMain.Items[I].Tag = 0 then mmMain.Items[I].Enabled := True;
for I := 0 to mmiSelect.Count - 1 do
if mmiSelect.Items[I].Tag = 0 then mmiSelect.Items[I].Enabled
for I := 0 to tlbMain.ButtonCount - 1 do
if tlbMain.Buttons[I].Tag = 0 then tlbMain.Buttons[I].Enabled
BorderIcons := [biSystemMenu, biMinimize, biMaximize];
end;
{-------------------------
procedure TfrmTyreAbsorb.MyHint(Send
begin
SB.Panels[0].Text := Application.Hint;
end;
{-------------------------
procedure TfrmTyreAbsorb.ReadTrips;
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
FfrmTrips.edtName1.Text := ConfigFile.ReadString('Cha
tbTrip1.Hint := FfrmTrips.edtName1.Text;
FfrmTrips.cbType1.ItemInde
FfrmTrips.edtName2.Text := ConfigFile.ReadString('Cha
tbTrip2.Hint := FfrmTrips.edtName2.Text;
FfrmTrips.cbType2.ItemInde
FfrmTrips.edtName3.Text := ConfigFile.ReadString('Cha
tbTrip3.Hint := FfrmTrips.edtName3.Text;
FfrmTrips.cbType3.ItemInde
FfrmTrips.edtName4.Text := ConfigFile.ReadString('Cha
tbTrip4.Hint := FfrmTrips.edtName4.Text;
FfrmTrips.cbType4.ItemInde
FfrmTrips.edtName5.Text := ConfigFile.ReadString('Cha
tbTrip5.Hint := FfrmTrips.edtName5.Text;
FfrmTrips.cbType5.ItemInde
FfrmTrips.edtName6.Text := ConfigFile.ReadString('Cha
tbTrip6.Hint := FfrmTrips.edtName6.Text;
FfrmTrips.cbType6.ItemInde
FfrmTrips.edtName7.Text := ConfigFile.ReadString('Cha
tbTrip7.Hint := FfrmTrips.edtName7.Text;
FfrmTrips.cbType7.ItemInde
FfrmTrips.edtName8.Text := ConfigFile.ReadString('Cha
tbTrip8.Hint := FfrmTrips.edtName8.Text;
FfrmTrips.cbType8.ItemInde
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.SaveTrips;
var
ConfigFile: TiniFile;
FileName: String;
begin
FileName := ExtractFilePath(ParamStr(0
if not FileExists(FileName) then raise ENoConfigFile.Create('');
ConfigFile := TIniFile.Create(FileName);
try
try
ConfigFile.WriteString('Ch
tbTrip1.Hint := FfrmTrips.edtName1.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip2.Hint := FfrmTrips.edtName2.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip3.Hint := FfrmTrips.edtName3.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip4.Hint := FfrmTrips.edtName4.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip5.Hint := FfrmTrips.edtName5.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip6.Hint := FfrmTrips.edtName6.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip7.Hint := FfrmTrips.edtName7.Text;
ConfigFile.WriteInteger('C
ConfigFile.WriteString('Ch
tbTrip8.Hint := FfrmTrips.edtName8.Text;
ConfigFile.WriteInteger('C
except
raise EConfigFileError.Create(''
end;
finally
ConfigFile.Free;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.CheckTrips;
var
DigInVal: SmallInt;
begin
{ Trip 1 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip1, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip1.ImageIndex := 7
else begin
tbTrip1.ImageIndex := 6;
case FfrmTrips.cbType1.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip1.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip1.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 2 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip2, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip2.ImageIndex := 7
else begin
tbTrip2.ImageIndex := 6;
case FfrmTrips.cbType2.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip2.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip2.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 3 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip3, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip3.ImageIndex := 7
else begin
tbTrip3.ImageIndex := 6;
case FfrmTrips.cbType3.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip3.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip3.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 4 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip4, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip4.ImageIndex := 7
else begin
tbTrip4.ImageIndex := 6;
case FfrmTrips.cbType4.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip4.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip4.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 5 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip5, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then tbTrip5.ImageIndex := 7 { 1 = drive zero? }
else begin
tbTrip5.ImageIndex := 6;
case FfrmTrips.cbType5.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip5.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip5.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 6 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip6, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 1 then tbTrip6.ImageIndex := 7 { 1 = transformer temp. }
else begin
tbTrip6.ImageIndex := 6;
case FfrmTrips.cbType6.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip6.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip6.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 7 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip7, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip7.ImageIndex := 7
else begin
tbTrip7.ImageIndex := 6;
case FfrmTrips.cbType7.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip7.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip7.Hint;
raise ETrip.Create('');
end;
end;
end;
{ Trip 8 }
FAcqErr := cbDBitIn(0, FIRSTPORTA, cDigInTrip8, DigInVal);
if FAcqErr <> 0 then raise EAcqCardError.Create('');
if DigInVal = 0 then tbTrip8.ImageIndex := 7
else begin
tbTrip8.ImageIndex := 6;
case FfrmTrips.cbType8.ItemInde
0:;
1: SB.Panels[cSbStatus].Text := 'Warning: ' + tbTrip8.Hint;
2: begin
SB.Panels[cSbStatus].Text := 'Critical: ' + tbTrip8.Hint;
raise ETrip.Create('');
end;
end;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiResultsC
var
Filter: String;
frmSaveTemp: TfrmSaveTemp;
DatFile: TIniFile;
I: Integer;
TS: String;
begin
Filter := odOpen.Filter;
OdOpen.Filter := 'Absorption Results (*.abs)|*.abs';
OdOpen.Title := 'Absorption Results';
try
if OdOpen.Execute then
begin
frmSaveTemp := TfrmSaveTemp.Create(Self);
frmSaveTemp.Caption := 'View test results';
DatFile := TIniFile.Create(odOpen.Fil
frmSaveTemp.edtActual1.Tex
frmSaveTemp.edtActual2.Tex
frmSaveTemp.edtActual3.Tex
frmSaveTemp.edtActual4.Tex
frmSaveTemp.edtActual5.Tex
frmSaveTemp.edtActual6.Tex
frmSaveTemp.edtInital.Text
frmSaveTemp.edtBead.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.edtAmbient.Tex
frmSaveTemp.edtTest.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.edtRise.Text := FloatToStr(DatFile.ReadFlo
frmSaveTemp.cbEng.Text := DatFile.ReadString('Test',
for I := 0 to 99 do
begin
TS := DatFile.ReadString('Test',
if TS = 'err' then break else frmSaveTemp.memComments.Li
end;
DatFile.Free;
for I := 0 to frmSaveTemp.ComponentCount
begin
if frmSaveTemp.Components[I].
TEdit(frmSaveTemp.Componen
if frmSaveTemp.Components[I].
TEdit(frmSaveTemp.Componen
end;
frmSaveTemp.ShowModal;
frmSaveTemp.Free;
end;
finally
OdOpen.Filter := Filter;
end;
end;
{-------------------------
procedure TfrmTyreAbsorb.mmiCoastCli
var
frmCoastMode: TfrmCoastMode;
begin
FCoastType := 0;
frmCoastMode := TfrmCoastMode.Create(Self)
try
if frmCoastMode.ShowModal = mrOk then
begin
FCoastType := frmCoastMode.rgLoad.ItemIn
mmiStartClick(Sender);
end;
finally
frmCoastMode.Free;
end;
end;
{-------------------------
end.
I think it needs the trtchart component adding. There is also another ThrdTimer error message that is basically the same.
first you have to install TRtChart component.
check any .dpk file is there or not?
if yes open it and install the component.
Otherwise use install component option of ide.
Rtchart.pas is component file.
check any .dpk file is there or not?
if yes open it and install the component.
Otherwise use install component option of ide.
Rtchart.pas is component file.
ASKER
There is no .dpk file.
How do i install it using the IDE?
There is New VCL component from the drop down menu, but then it wants me to pick a Component name and TRTChart is not in the list.
How do i install it using the IDE?
There is New VCL component from the drop down menu, but then it wants me to pick a Component name and TRTChart is not in the list.
ASKER
Update ....
On the menu i chose Component -> New VCL Component
From the list i chose TComponent because I saw that on the create bit of TRtChart above.
On the next screen i put
Class Name: TRtChart
Pallette Page: Servocon
Unit Name: I located the current RtChart.pas in a folder of my C:\ drive
Search path: I just left this alone
On the next screen there was only one radio button that said create unit, that was ticked and i could not un tick it. So i clicked finish and it seemed to create a new class for me with that stuff in.
But i want to use the existing class that has been written dont I?? So how do i get that in to work?
On the menu i chose Component -> New VCL Component
From the list i chose TComponent because I saw that on the create bit of TRtChart above.
On the next screen i put
Class Name: TRtChart
Pallette Page: Servocon
Unit Name: I located the current RtChart.pas in a folder of my C:\ drive
Search path: I just left this alone
On the next screen there was only one radio button that said create unit, that was ticked and i could not un tick it. So i clicked finish and it seemed to create a new class for me with that stuff in.
But i want to use the existing class that has been written dont I?? So how do i get that in to work?
i am using delphi 7.i don't no more about BDS2006.
Not Component -> New VCL Component
any other option like Component -> Install Component..
Not Component -> New VCL Component
any other option like Component -> Install Component..
with BDS2006 you can't install a 'loose' component
all components have to be 'wrapped' in packages.
So go to File -> new -> Package
their you'll have to add your component to the 'contains' section, save the package somewhere.
Then go to Component -> install package
and install the package you've just created
all components have to be 'wrapped' in packages.
So go to File -> new -> Package
their you'll have to add your component to the 'contains' section, save the package somewhere.
Then go to Component -> install package
and install the package you've just created
ASKER
On the component drop down menu there are ...
Installed .NET Components ...
New VCL Component ...
Create Component template ... (This is greyed out)
Install Packages ...
Import Component ...
If i go to the import component it gives me 3 options ...
Import a Type Library
Import ActiveX Control
Import .Net Assembley
I chose type library because i dont thing its either of the other 2.
It then lists lots of type librarys. It has an add button so i clicked that.
An open file dialog appears and it is looking for either a .dll, .ocx, .olb or .tlb. Not a .pas file. I can select any file and if i do that and try to add it it says Error loadinf type library file /DLL.
Any ideas?
Installed .NET Components ...
New VCL Component ...
Create Component template ... (This is greyed out)
Install Packages ...
Import Component ...
If i go to the import component it gives me 3 options ...
Import a Type Library
Import ActiveX Control
Import .Net Assembley
I chose type library because i dont thing its either of the other 2.
It then lists lots of type librarys. It has an add button so i clicked that.
An open file dialog appears and it is looking for either a .dll, .ocx, .olb or .tlb. Not a .pas file. I can select any file and if i do that and try to add it it says Error loadinf type library file /DLL.
Any ideas?
ASKER
Will try MerijnB. suggestion now.
Okay, first of all, when upgrading to BDS2006, you will have to make sure you have the sources for ALL components used in this project. Any *.DCU files that were used by Delphi 5 will be worthless for you. (But BDS2006 will create new ones.) It could be that the previous developer used a few DCU-only components in which case you will have lots of problems finding updated versions of those units.
Furthermore, such an upgrade is already complex for experienced Delphi developers so if you're inexperienced, it will become a real nightmare. It would be easier to just familiarize yourself with Delphi and this project by using Delphi 5 first.
About those component packages that your project is using... Those are probably Delphi 5 packages so they will need to be converted and possibly adjusted a bit. The upgrade isn't difficult (just open the *.pkg file in BDS2006) but getting the components to install and work properly will take some time. It depends on how well-built those packages are. With a bit of luck, all you need to do is modify the uses clause a bit. In the worst case you will have to refactor all the units in the package, splitting functionality up in runtime and designtime functionality.
Also, the changes in the components in BDS2006 compared to D5 are significant. Delphi did manage to keep a lot of it's backwards compatibility but some things will behave differently, thus they might cause some unexpected behavior.
If you're new to Delphi, I would advise you hire an experienced Delphi developer for a month or so and work together with him for this upgrade. Things might become more complex than you think.
Furthermore, such an upgrade is already complex for experienced Delphi developers so if you're inexperienced, it will become a real nightmare. It would be easier to just familiarize yourself with Delphi and this project by using Delphi 5 first.
About those component packages that your project is using... Those are probably Delphi 5 packages so they will need to be converted and possibly adjusted a bit. The upgrade isn't difficult (just open the *.pkg file in BDS2006) but getting the components to install and work properly will take some time. It depends on how well-built those packages are. With a bit of luck, all you need to do is modify the uses clause a bit. In the worst case you will have to refactor all the units in the package, splitting functionality up in runtime and designtime functionality.
Also, the changes in the components in BDS2006 compared to D5 are significant. Delphi did manage to keep a lot of it's backwards compatibility but some things will behave differently, thus they might cause some unexpected behavior.
If you're new to Delphi, I would advise you hire an experienced Delphi developer for a month or so and work together with him for this upgrade. Things might become more complex than you think.
ASKER
It comes up with come warnings when i compile the package ....
ThdTimer implicty imported into package chart
ChartExt implicty imported into package chart
ExpPro implicty imported into package chart
should i ignore these?
ThdTimer implicty imported into package chart
ChartExt implicty imported into package chart
ExpPro implicty imported into package chart
should i ignore these?
yep
i don't know this is useful for you.
http://delphi.about.com/od/vclusing/ss/newcomponentbpl.htm
add these three to the package
ThdTimer.pas,ChartExt.pas,
ASKER
Well i added them but when i try to open the form shown above the application is just hanging.
They all compiled Ok, but now it has been 5 mins and the form still has not come up and i have tried it 3 times inclusing a PC restart. Any ideas?
Also, does anyone know or heard of any of these components, im thinking if they were community ones and the programmer from the company had not wrote them then there may be an update for delphi 2006.
The components i think need to be added are called ...
ChartExt.pas, ExpPrp.pas, RtChart.pas, ThdTimer.pas, info.pas, FileFind.pas
They all compiled Ok, but now it has been 5 mins and the form still has not come up and i have tried it 3 times inclusing a PC restart. Any ideas?
Also, does anyone know or heard of any of these components, im thinking if they were community ones and the programmer from the company had not wrote them then there may be an update for delphi 2006.
The components i think need to be added are called ...
ChartExt.pas, ExpPrp.pas, RtChart.pas, ThdTimer.pas, info.pas, FileFind.pas
go to application folder.
open .dof file with notpad and check any removed pakages is there.
i am not sure .dof or .cfg.
open .dof file with notpad and check any removed pakages is there.
i am not sure .dof or .cfg.
ASKER
Do you mean the Borland Bin folder where BDS2006 is executed from?
There are some .config files in there no .dof or .cfg files though. Couldnt see anything that related to components in the .config files.
There are some .config files in there no .dof or .cfg files though. Couldnt see anything that related to components in the .config files.
ASKER
There is a .cfg file in the same folder as the application i have been creating. It has no references to any components in there. It looks like specifi information for use of the PCI card.
No
i think "C:\ drive" in which your application exists.
i think "C:\ drive" in which your application exists.
What is your project name?
means .dpr filename
means .dpr filename
ASKER
Absorption.dpr
ASKER
I have found the .dof file.
Can i remove all the packages and start again or is the project using some already?
Can i remove all the packages and start again or is the project using some already?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Now try to open Absorption.dpr
ASKER
Ok that seems to work and run.
The only problem now is that when i quit the application it stays in memory working as a process. Any clues on that?
The only problem now is that when i quit the application it stays in memory working as a process. Any clues on that?
it is very defficult me to say answer.
Use trace option to find out that error.
For that you have to set 'use debug DCUs' true.
Projects-> options->
in compiler tab you can see this option
Bust of luck.
Use trace option to find out that error.
For that you have to set 'use debug DCUs' true.
Projects-> options->
in compiler tab you can see this option
Bust of luck.
ASKER
Ok thanks for your help!
are there any threads other than main thread running?
ASKER
Yes there is another thread running, could this be the problem?
I have stepped through the program and on the form the is an exit drop down menu. The exit drop down menu calls the code ...
close;
I thought that should close the whole application? However if i step through the code it steps through it then goes to another form.
I have stepped through the program and on the form the is an exit drop down menu. The exit drop down menu calls the code ...
close;
I thought that should close the whole application? However if i step through the code it steps through it then goes to another form.
Is this Close() called from within the context of your mainform?
is there anything in the onclose or ondestroy events of your mainform?
is there anything in the onclose or ondestroy events of your mainform?
ASKER
Thanks, I will open another question I have a bit more info.
Paste some code, some error messages, etc