Customised foobot_sensors unit added. This replaces sensors.pas in Industrial components package

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5591 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
2017-01-04 14:23:45 +00:00
parent d57e7fe585
commit e7dce54cf8
6 changed files with 607 additions and 69 deletions

View File

@ -0,0 +1,487 @@
{ Copyright (C) 1998-2000, written by Shkolnik Mike
FIDOnet: 2:463/106.14
E-Mail: mshkolnik@scalabium.com
mshkolnik@yahoo.com
WEB: http://www.scalabium.com
http://www.geocities.com/mshkolnik
tel: 380-/44/-552-10-29
TStopLightSensor and TAnalogSensor sensor components
Modified by Jurassic Pork for Lazarus "Industrial" package
}
unit foobot_sensors;
{$mode objfpc}{$H+}
interface
uses LCLIntf, LCLType, LResources, Classes, Controls, Graphics, Stdctrls, Extctrls;
type
TStopLights = (slUNKNOWN, slRED, slYELLOW, slGREEN);
type
TSensorPanel = class(TPanel)
private
FlblShowText: TLabel; {sensor value}
FShowText: Boolean;
FShowLevel: Boolean; {show the RED and YELLOW levels or not}
FValue: Double;
FValueMin: Double;
FValueMax: Double;
FValueRed: Double;
FValueYellow: Double;
FColorBack: TColor;
FColorFore: TColor;
FColorRed: TColor;
FColorYellow: TColor;
function GetCaption: TCaption;
procedure SetCaption(AValue: TCaption);
procedure SetShowText(AValue: Boolean);
procedure SetShowLevel(AValue: Boolean);
procedure SetColorInd(Index: Integer; AValue: TColor);
procedure SetValue(AValue: Double); virtual;
procedure SetValueMin(AValue: Double);
procedure SetValueMax(AValue: Double);
procedure SetValueRed(AValue: Double);
procedure SetValueYellow(AValue: Double);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function GetStatus: TStopLights;
procedure SetColorState(slStopLight: TStopLights); virtual;
published
property Caption read GetCaption write SetCaption;
property ShowText: Boolean read FShowText write SetShowText;
property ShowLevel: Boolean read FShowLevel write SetShowLevel;
property ColorFore: TColor index 0 read FColorFore write SetColorInd default clLime;
property ColorBack: TColor index 1 read FColorBack write SetColorInd default clBlack;
property ColorRed: TColor index 2 read FColorRed write SetColorInd default clRed;
property ColorYellow: TColor index 3 read FColorYellow write SetColorInd default clYellow;
property Value: Double read FValue write SetValue;
property ValueMin: Double read FValueMin write SetValueMin;
property ValueMax: Double read FValueMax write SetValueMax;
property ValueRed: Double read FValueRed write SetValueRed;
property ValueYellow: Double read FValueYellow write SetValueYellow;
end;
TAnalogKind = (akAnalog, akHorizontal, akVertical);
TAnalogSensor = class(TSensorPanel)
private
FAnalogKind: TAnalogKind;
procedure PaintAsNeedle;
procedure PaintAsHorizontal;
procedure PaintAsVertical;
procedure SetAnalogKind(AValue: TAnalogKind);
protected
procedure Paint; override;
public
constructor Create(AOwner: TComponent); override;
published
property Font;
property AnalogKind: TAnalogKind read FAnalogKind write SetAnalogKind;
end;
TStopLightSensor = class(TImage)
private
FState: TStopLights;
procedure SetState(AValue: TStopLights);
protected
public
constructor Create(AOwner: TComponent); override;
published
property Center default True;
property State: TStopLights read FState write SetState;
end;
implementation
{$R sensors.res}
uses SysUtils;
{ TSensorPanel }
constructor TSensorPanel.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 75;
Width := 170;
Parent := AOwner as TWinControl;
FValue := 0;
FValueMin := 0;
FValueMax := 100;
FValueRed := 30;
FValueYellow := 60;
FColorFore := {clGreen} clLime;
FColorBack := clBlack {clWhite};
FColorRed := clRed;
FColorYellow := clYellow;
FlblShowText := TLabel.Create(Self);
with FlblShowText do
begin
Alignment := taCenter;
AutoSize := False;
Font := Self.Font;
Height := 17;
Left := 5;
Top := 57;
Width := 160;
Parent := Self;
Align := alBottom;
end;
FShowLevel := True;
Caption := '';
ShowText := True;
end;
destructor TSensorPanel.Destroy;
begin
// FlblShowText.Free;
inherited Destroy;
end;
function TSensorPanel.GetStatus: TStopLights;
begin
Result := slUNKNOWN;
if (Value > ValueMin) and (Value < ValueMin) then Result := slGREEN;
if (Value < ValueYellow) then Result := slYellow;
if (Value < ValueRed) then Result := slRED;
end;
procedure TSensorPanel.SetColorState(slStopLight: TStopLights);
begin
FlblShowText.Font := Font;
case slStopLight of
slRED: FlblShowText.Font.Color := FColorRed;
slYELLOW: FlblShowText.Font.Color := FColorYellow;
else // slUNKNOWN, slGREEN
// FlblShowText.Font := Font;
end;
end;
procedure TSensorPanel.SetValue(AValue: Double);
begin
if (AValue < FValueMin) then
AValue := FValueMin
else
if (AValue > FValueMax) then
AValue := FValueMax;
if (FValue <> AValue) then
begin
FValue := AValue;
FlblShowText.Caption := FlblShowText.Hint + FloatToStr(FValue);
Invalidate;
end;
end;
function TSensorPanel.GetCaption: TCaption;
begin
// Modif J.P 05/2013 Caption replace Hint
Result := FlblShowText.Hint;
end;
procedure TSensorPanel.SetCaption(AValue: TCaption);
begin
// Modif J.P 05/2013 Caption replace Hint
FlblShowText.Hint := AValue;
inherited Caption := '';
FlblShowText.Caption := FlblShowText.Hint + FloatToStr(FValue);
Invalidate;
end;
procedure TSensorPanel.SetShowText(AValue: Boolean);
begin
if (AValue <> FShowText) then
begin
FShowText := AValue;
FlblShowText.Visible := FShowText;
end;
end;
procedure TSensorPanel.SetShowLevel(AValue: Boolean);
begin
if (AValue <> FShowLevel) then
begin
FShowlevel := AValue;
Invalidate;
end;
end;
procedure TSensorPanel.SetColorInd(Index: Integer; AValue: TColor);
begin
if (AValue <> FColorFore) then
begin
case Index of
0: FColorFore := AValue;
1: FColorBack := AValue;
2: FColorRed := AValue;
3: FColorYellow := AValue;
end;
Invalidate;
end;
end;
procedure TSensorPanel.SetValueMin(AValue: Double);
begin
if (AValue <> FValueMin) then
begin
{
if (AValue > FValueMin) then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt('OutOfRange', [-MaxInt, Round(FValueMax - 1)]);
}
FValueMin := AValue;
if (FValue < AValue) then FValue := AValue;
Invalidate;
end;
end;
procedure TSensorPanel.SetValueMax(AValue: Double);
begin
if (AValue <> FValueMax) then
begin
if (AValue < FValueMin) then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt('SOutOfRange', [Round(FValueMin + 1), MaxInt]);
FValueMax := AValue;
if (FValue > AValue) then FValue := AValue;
Invalidate;
end;
end;
procedure TSensorPanel.SetValueRed(AValue: Double);
begin
if (AValue <> FValueRed) then
begin
if (AValue < FValueMin) or (AValue > FValueMax) then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt('SOutOfRange', [Round(FValueMin), Round(FValueMax)]);
FValueRed := AValue;
Invalidate;
end;
end;
procedure TSensorPanel.SetValueYellow(AValue: Double);
begin
if (AValue <> FValueYellow) then
begin
if (AValue < 1) or (AValue > FValueMax) then
if not (csLoading in ComponentState) then
raise EInvalidOperation.CreateFmt('SOutOfRange', [Round(FValueRed), Round(FValueMax)]);
FValueYellow := AValue;
Invalidate;
end;
end;
{ TAnalogSensor }
constructor TAnalogSensor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Value := 20;
AnalogKind := akAnalog;
end;
procedure TAnalogSensor.Paint;
begin
inherited Paint;
case FAnalogKind of
akAnalog: PaintAsNeedle;
akHorizontal: PaintAsHorizontal;
akVertical: PaintAsVertical;
end;
end;
function SolveForY(X, Z: Double): Double;
begin
if Z = 0 then
Result := 0
else
Result := X/Z;
end;
procedure TAnalogSensor.PaintAsNeedle;
var MiddleX: Integer;
Angle: Double;
X, Y, W, H: Integer;
begin
X := 20;
Y := 23;
W := ClientWidth - 2*20; //130;
H := ClientHeight - 2*23; //33;
if (W < 1) or (H < 1) then Exit;
with Canvas do
begin
Brush.Color := ColorBack;
Pen.Color := clBlack;
Pen.Width := 1;
{ draw a pie }
Pie(X, Y, X + W, Y + 2*H, X + W, Y + H - 1, X, Y + H - 1);
// Chord(X, Y, X+W, (Y+H)*2, X+W, Y+H-1, X, Y+H-1);
MiddleX := W div 2;
{ draw pie for current value }
Brush.Color := ColorFore;
Pen.Color := clBlack;
MoveTo(X + MiddleX, Y + H - 1);
Angle := Pi * SolveForY(FValue - FValueMin, FValueMax - FValueMin);
Pie(X, Y, X + W, Y + 2*H, Round(X + MiddleX*(1 - Cos(Angle))), Round(Y - 1 + H*(1 - Sin(Angle))), X, Y+H);
if FShowLevel then
begin
// Pen.Width := 1;
{ draw a RED level line }
Pen.Color := ColorRed;
MoveTo(X + MiddleX, Y + H - 1);
Angle := Pi * SolveForY(FValueRed - FValueMin, FValueMax - FValueMin);
LineTo(Round(X + MiddleX*(1 - Cos(Angle))), Round(Y - 1 + H*(1 - Sin(Angle))));
{ draw a YELLOW level line }
Pen.Color := ColorYellow;
MoveTo(X + MiddleX, Y + H - 1);
Angle := Pi * SolveForY(FValueYellow - FValueMin, FValueMax - FValueMin);
LineTo(Round(X + MiddleX*(1 - Cos(Angle))), Round(Y - 1 + H*(1 - Sin(Angle))));
end;
end;
end;
procedure TAnalogSensor.PaintAsHorizontal;
var MiddleX: Integer;
X, Y, W, H: Integer;
begin
X := 20;
Y := 23;
W := ClientWidth - 2*20; //130;
H := ClientHeight - 2*23; //33;
if (W < 1) or (H < 1) then Exit;
with Canvas do
begin
Brush.Color := ColorBack;
Pen.Color := clBlack;
Pen.Width := 1;
Rectangle(X, Y, X + W, Y + H);
{ draw pie for current value }
Brush.Color := ColorFore;
Pen.Color := clBlack;
MiddleX := Round(W*SolveForY(FValue - FValueMin, FValueMax - FValueMin));
Rectangle(X, Y, X + MiddleX, Y + H);
if FShowLevel then
begin
{ draw a RED level line }
Pen.Color := ColorRed;
MiddleX := Round(W*SolveForY(FValueRed - FValueMin, FValueMax - FValueMin));
MoveTo(X + MiddleX, Y + 1);
LineTo(X + MiddleX, Y + H - 1);
{ draw a YELLOW level line }
Pen.Color := ColorYellow;
MiddleX := Round(W*SolveForY(FValueYellow - FValueMin, FValueMax - FValueMin));
MoveTo(X + MiddleX, Y + 1);
LineTo(X + MiddleX, Y + H - 1);
end;
end;
end;
procedure TAnalogSensor.PaintAsVertical;
var MiddleY: Integer;
X, Y, W, H: Integer;
begin
X := 20;
Y := 23;
W := ClientWidth - 2*20; //130;
H := ClientHeight - 2*23; //33;
if (W < 1) or (H < 1) then Exit;
with Canvas do
begin
Brush.Color := ColorBack;
Pen.Color := clBlack;
Pen.Width := 1;
Rectangle(X + W - 1, Y + H - 1, X, Y);
{ draw pie for current value }
Brush.Color := ColorFore;
Pen.Color := clBlack;
MiddleY := Round(H*SolveForY(FValue - FValueMin, FValueMax - FValueMin));
Rectangle(X, Y + H - 1 - MiddleY, X + W - 1, Y + H - 1);
if FShowLevel then
begin
{ draw a RED level line }
Pen.Color := ColorRed;
MiddleY := Round(H*SolveForY(FValueRed - FValueMin, FValueMax - FValueMin));
MoveTo(X + 1, Y + H - 1 - MiddleY);
LineTo(X + W - 1, Y + H - 1 - MiddleY);
{ draw a YELLOW level line }
Pen.Color := ColorYellow;
MiddleY := Round(H*SolveForY(FValueYellow - FValueMin, FValueMax - FValueMin));
MoveTo(X + 1, Y + H - 1 - MiddleY);
LineTo(X + W - 1, Y + H - 1 - MiddleY);
end;
end;
end;
procedure TAnalogSensor.SetAnalogKind(AValue: TAnalogKind);
begin
if (AValue <> FAnalogKind) then
begin
FAnalogKind := AValue;
Invalidate;
end;
end;
{ TStopLightSensor }
constructor TStopLightSensor.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Width := 23;
Height := 43;
Center := True;
FState := slRED;
State := slUNKNOWN;
end;
procedure TStopLightSensor.SetState(AValue: TStopLights);
begin
if (AValue <> FState) then
begin
FState := AValue;
case AValue of
slUNKNOWN: Picture.LoadFromResourceName(HInstance, 'STOP_UNKNOWN', TPortableNetworkGraphic);
slRED: Picture.LoadFromResourceName(HInstance, 'STOP_RED', TPortableNetworkGraphic);
slYELLOW: Picture.LoadFromResourceName(HInstance, 'STOP_YELLOW', TPortableNetworkGraphic);
slGREEN: Picture.LoadFromResourceName(HInstance, 'STOP_GREEN', TPortableNetworkGraphic);
end;
end;
end;
end.

View File

@ -4,13 +4,13 @@
<PathDelim Value="\"/>
<Version Value="10"/>
<BuildModes Active="linux64"/>
<Units Count="25">
<Units Count="27">
<Unit0>
<Filename Value="foobotmonitor.lpr"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="8"/>
<EditorIndex Value="10"/>
<CursorPos X="33" Y="25"/>
<UsageCount Value="79"/>
<UsageCount Value="84"/>
<Loaded Value="True"/>
</Unit0>
<Unit1>
@ -19,10 +19,9 @@
<ComponentName Value="mainform"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<TopLine Value="312"/>
<CursorPos X="36" Y="329"/>
<UsageCount Value="79"/>
<TopLine Value="59"/>
<CursorPos X="15" Y="79"/>
<UsageCount Value="84"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
@ -32,9 +31,9 @@
<ComponentName Value="configform"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<EditorIndex Value="2"/>
<EditorIndex Value="4"/>
<CursorPos X="2" Y="20"/>
<UsageCount Value="69"/>
<UsageCount Value="74"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
@ -44,7 +43,7 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="61"/>
<UsageCount Value="66"/>
</Unit3>
<Unit4>
<Filename Value="..\foobot_objects.pas"/>
@ -53,15 +52,15 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="61"/>
<UsageCount Value="66"/>
</Unit4>
<Unit5>
<Filename Value="..\foobot_utility.pas"/>
<IsPartOfProject Value="True"/>
<EditorIndex Value="5"/>
<EditorIndex Value="7"/>
<TopLine Value="34"/>
<CursorPos X="18" Y="83"/>
<UsageCount Value="79"/>
<UsageCount Value="84"/>
<Loaded Value="True"/>
</Unit5>
<Unit6>
@ -71,21 +70,21 @@
<WindowIndex Value="-1"/>
<TopLine Value="-1"/>
<CursorPos X="-1" Y="-1"/>
<UsageCount Value="61"/>
<UsageCount Value="66"/>
</Unit6>
<Unit7>
<Filename Value="..\latest_stable\foobot_httpclient.pas"/>
<EditorIndex Value="3"/>
<EditorIndex Value="5"/>
<TopLine Value="43"/>
<CursorPos X="47" Y="13"/>
<UsageCount Value="56"/>
<UsageCount Value="58"/>
<Loaded Value="True"/>
</Unit7>
<Unit8>
<Filename Value="..\latest_stable\foobot_objects.pas"/>
<EditorIndex Value="7"/>
<EditorIndex Value="9"/>
<CursorPos X="32" Y="61"/>
<UsageCount Value="56"/>
<UsageCount Value="58"/>
<Loaded Value="True"/>
</Unit8>
<Unit9>
@ -118,10 +117,10 @@
</Unit12>
<Unit13>
<Filename Value="..\umainform.pas"/>
<EditorIndex Value="4"/>
<EditorIndex Value="6"/>
<TopLine Value="284"/>
<CursorPos X="38" Y="313"/>
<UsageCount Value="36"/>
<UsageCount Value="38"/>
<Loaded Value="True"/>
</Unit13>
<Unit14>
@ -152,12 +151,13 @@
<UsageCount Value="8"/>
</Unit17>
<Unit18>
<Filename Value="C:\trunklatest\lazarus\components\IndustrialStuff\source\sensors.pas"/>
<UnitName Value="Sensors"/>
<EditorIndex Value="-1"/>
<TopLine Value="237"/>
<CursorPos Y="265"/>
<UsageCount Value="9"/>
<Filename Value="foobot_sensors.pas"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="258"/>
<CursorPos X="44" Y="274"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit18>
<Unit19>
<Filename Value="C:\trunklatest\lazarus\ide\lazarus.pp"/>
@ -190,19 +190,34 @@
</Unit22>
<Unit23>
<Filename Value="C:\trunklatest\fpc\packages\rtl-objpas\src\inc\dateutil.inc"/>
<EditorIndex Value="6"/>
<EditorIndex Value="8"/>
<TopLine Value="381"/>
<CursorPos X="24" Y="409"/>
<UsageCount Value="25"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit23>
<Unit24>
<Filename Value="..\latest_stable\udataform.pas"/>
<EditorIndex Value="1"/>
<EditorIndex Value="3"/>
<TopLine Value="70"/>
<UsageCount Value="25"/>
<UsageCount Value="27"/>
<Loaded Value="True"/>
</Unit24>
<Unit25>
<Filename Value="D:\lazarustrunk\common_components\cryptini\ucryptini.pas"/>
<EditorIndex Value="2"/>
<TopLine Value="781"/>
<CursorPos X="28" Y="795"/>
<UsageCount Value="12"/>
<Loaded Value="True"/>
</Unit25>
<Unit26>
<Filename Value="C:\trunklatest\fpc\packages\fcl-base\src\fileinfo.pp"/>
<EditorIndex Value="-1"/>
<TopLine Value="43"/>
<CursorPos X="19" Y="51"/>
<UsageCount Value="12"/>
</Unit26>
</Units>
<OtherDefines Count="1">
<Define0 Value="DEBUGMODE"/>
@ -210,123 +225,123 @@
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="umainform.pas"/>
<Caret Line="304" Column="57" TopLine="299"/>
<Caret Line="529" Column="32" TopLine="487"/>
</Position1>
<Position2>
<Filename Value="umainform.pas"/>
<Caret Line="508" Column="30" TopLine="472"/>
<Caret Line="532" Column="27" TopLine="489"/>
</Position2>
<Position3>
<Filename Value="umainform.pas"/>
<Caret Line="515" Column="30" TopLine="479"/>
<Caret Line="535" Column="25" TopLine="494"/>
</Position3>
<Position4>
<Filename Value="umainform.pas"/>
<Caret Line="287" Column="66" TopLine="243"/>
<Caret Line="531" Column="26" TopLine="494"/>
</Position4>
<Position5>
<Filename Value="umainform.pas"/>
<Caret Line="529" Column="32" TopLine="487"/>
<Caret Line="530" Column="5" TopLine="495"/>
</Position5>
<Position6>
<Filename Value="umainform.pas"/>
<Caret Line="532" Column="27" TopLine="489"/>
<Caret Line="529" Column="5" TopLine="494"/>
</Position6>
<Position7>
<Filename Value="umainform.pas"/>
<Caret Line="535" Column="25" TopLine="494"/>
<Caret Line="509" Column="22" TopLine="488"/>
</Position7>
<Position8>
<Filename Value="umainform.pas"/>
<Caret Line="531" Column="26" TopLine="494"/>
<Caret Line="530" Column="25" TopLine="490"/>
</Position8>
<Position9>
<Filename Value="umainform.pas"/>
<Caret Line="530" Column="5" TopLine="495"/>
<Filename Value="..\foobot_utility.pas"/>
<Caret Line="243" Column="47" TopLine="218"/>
</Position9>
<Position10>
<Filename Value="umainform.pas"/>
<Caret Line="529" Column="5" TopLine="494"/>
<Caret Line="527" Column="68" TopLine="486"/>
</Position10>
<Position11>
<Filename Value="umainform.pas"/>
<Caret Line="509" Column="22" TopLine="488"/>
<Caret Line="523" Column="17" TopLine="488"/>
</Position11>
<Position12>
<Filename Value="umainform.pas"/>
<Caret Line="530" Column="25" TopLine="490"/>
<Caret Line="245" TopLine="243"/>
</Position12>
<Position13>
<Filename Value="..\foobot_utility.pas"/>
<Caret Line="243" Column="47" TopLine="218"/>
<Filename Value="umainform.pas"/>
<Caret Line="244" TopLine="242"/>
</Position13>
<Position14>
<Filename Value="umainform.pas"/>
<Caret Line="527" Column="68" TopLine="486"/>
<Caret Line="264" Column="31" TopLine="242"/>
</Position14>
<Position15>
<Filename Value="umainform.pas"/>
<Caret Line="523" Column="17" TopLine="488"/>
<Caret Line="532" Column="43" TopLine="497"/>
</Position15>
<Position16>
<Filename Value="umainform.pas"/>
<Caret Line="245" TopLine="243"/>
<Caret Line="188" Column="16" TopLine="176"/>
</Position16>
<Position17>
<Filename Value="umainform.pas"/>
<Caret Line="244" TopLine="242"/>
<Caret Line="572" Column="44" TopLine="551"/>
</Position17>
<Position18>
<Filename Value="umainform.pas"/>
<Caret Line="264" Column="31" TopLine="242"/>
<Caret Line="613" Column="58" TopLine="591"/>
</Position18>
<Position19>
<Filename Value="umainform.pas"/>
<Caret Line="532" Column="43" TopLine="497"/>
<Caret Line="620" Column="58" TopLine="598"/>
</Position19>
<Position20>
<Filename Value="umainform.pas"/>
<Caret Line="188" Column="16" TopLine="176"/>
<Caret Line="374" Column="71" TopLine="344"/>
</Position20>
<Position21>
<Filename Value="umainform.pas"/>
<Caret Line="572" Column="44" TopLine="551"/>
<Caret Line="373" Column="11" TopLine="351"/>
</Position21>
<Position22>
<Filename Value="umainform.pas"/>
<Caret Line="613" Column="58" TopLine="591"/>
<Caret Line="292" Column="24" TopLine="248"/>
</Position22>
<Position23>
<Filename Value="umainform.pas"/>
<Caret Line="620" Column="58" TopLine="598"/>
<Caret Line="286" Column="21" TopLine="283"/>
</Position23>
<Position24>
<Filename Value="umainform.pas"/>
<Caret Line="374" Column="71" TopLine="344"/>
<Caret Line="58" Column="29" TopLine="35"/>
</Position24>
<Position25>
<Filename Value="umainform.pas"/>
<Caret Line="373" Column="11" TopLine="351"/>
<Caret Line="347" Column="40" TopLine="311"/>
</Position25>
<Position26>
<Filename Value="umainform.pas"/>
<Caret Line="292" Column="24" TopLine="248"/>
<Filename Value="D:\lazarustrunk\common_components\cryptini\ucryptini.pas"/>
<Caret Line="795" Column="28" TopLine="781"/>
</Position26>
<Position27>
<Filename Value="umainform.pas"/>
<Caret Line="286" Column="21" TopLine="283"/>
<Caret Line="646" Column="114" TopLine="641"/>
</Position27>
<Position28>
<Filename Value="umainform.pas"/>
<Caret Line="58" Column="29" TopLine="35"/>
<Caret Line="433" Column="3" TopLine="583"/>
</Position28>
<Position29>
<Filename Value="umainform.pas"/>
<Caret Line="211" TopLine="314"/>
<Caret Line="434" Column="3" TopLine="434"/>
</Position29>
<Position30>
<Filename Value="umainform.pas"/>
<Caret Line="347" Column="40" TopLine="311"/>
<Caret Line="48" Column="11" TopLine="34"/>
</Position30>
</JumpHistory>
</ProjectSession>

View File

@ -415,6 +415,11 @@ object mainform: Tmainform
end
object mnu_optionsSampleEvery: TMenuItem
Caption = 'Sample every...'
object mnu_SampleEveryHalfHour: TMenuItem
AutoCheck = True
Caption = 'Half-Hour'
OnClick = mnu_SampleEveryHalfHourClick
end
object mnu_SampleEvery1Hour: TMenuItem
AutoCheck = True
Caption = 'Hour (default)'

View File

@ -25,10 +25,12 @@ V0.0.1.0: Initial commit
V0.0.2.0: Trayicon added
V0.0.3.0: Added Help menu. Updated Options menu
V0.0.4.0: Graph added
V0.0.5.0: ??
V0.1.0.0: Save/Load Alltime High/Lows. Reset values from menu
V0.1.1.0: Save/Load Colours, Min and Max values to cfg file
V0.1.2.0: ??
}
{$ifopt D+}
// Debug mode
// Debug mode does not load data from web
{$ENDIF}
{$mode objfpc}{$H+}
@ -36,13 +38,14 @@ V0.0.5.0: ??
interface
uses
Classes, SysUtils, FileUtil, TAGraph, TAIntervalSources, TASeries,
SysUtils, TAGraph, TAIntervalSources, TASeries,
Sensors, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, Menus,
lclIntf, foobot_utility, uCryptIni, Variants, dateutils, uconfigform;
lclIntf, foobot_utility, uCryptIni, dateutils, uconfigform, Classes;
const
// Timer milliseconds
ONEMINUTE = 60000;
HALFHOUR = ONEMINUTE * 30;
ONEHOUR = ONEMINUTE * 60;
TWOHOURS = ONEHOUR * 2;
FOURHOURS = ONEHOUR * 4;
@ -71,6 +74,13 @@ const
MIN_ALLPOLLU = 0;
MAX_ALLPOLLU = 700;
// Sensor recommended levels
REC_PM = 25;
REC_TMP = 23;
REC_HUM = 60;
REC_CO2 = 1300;
REC_VOC = 300;
REC_ALLPOLLU = 50;
type
@ -113,6 +123,7 @@ type
lbl_voclow: TLabel;
lbl_allpollulow: TLabel;
MainMenu1: TMainMenu;
mnu_SampleEveryHalfHour: TMenuItem;
mnu_optionsResetHighsLows: TMenuItem;
mnu_optionsOnlineHelp: TMenuItem;
mnu_optionsSeperator1: TMenuItem;
@ -155,6 +166,7 @@ type
procedure mnu_SampleEvery2HoursClick(Sender: TObject);
procedure mnu_SampleEvery4HoursClick(Sender: TObject);
procedure mnu_SampleEvery8HoursClick(Sender: TObject);
procedure mnu_SampleEveryHalfHourClick(Sender: TObject);
procedure tmr_foobotTimer(Sender: TObject);
procedure TrayIcon1Click(Sender: TObject);
private
@ -166,6 +178,7 @@ type
procedure UpdateHighLow(SensorNumber: integer);
procedure GraphHistory;
procedure GraphCurrentReading;
Procedure SetRecommendedLevels;
procedure SaveConfig;
procedure LoadConfig;
public
@ -243,12 +256,12 @@ begin
GraphHistory;
{$IFNDEF DEBUGMODE}
mnu_optionsTakeReadingNow.Click;
{$ENDIF}
{$ENDIF}
// Switch off for testing
tmr_foobot.Interval := ONEHOUR;
{$IFNDEF DEBUGMODE}
tmr_foobot.Enabled := True;
{$ENDIF}
{$ENDIF}
Show;
end;
end
@ -436,6 +449,12 @@ begin
ShowMessage('Sorry - no readings available');
mainform.Cursor := crDefault;
end;
procedure Tmainform.mnu_SampleEveryHalfHourClick(Sender: TObject);
begin
tmr_foobot.Enabled := False;
tmr_foobot.Interval := HALFHOUR;
tmr_foobot.Enabled := True;
end;
procedure Tmainform.mnu_SampleEvery1HourClick(Sender: TObject);
begin
@ -472,6 +491,7 @@ begin
tmr_foobot.Enabled := True;
end;
procedure Tmainform.tmr_foobotTimer(Sender: TObject);
begin
if FetchFoobotData(dfLast, 0, 0, 0, 0, 0, sSecretKey) then
@ -483,6 +503,16 @@ begin
mainform.Show;
end;
Procedure Tmainform.SetRecommendedLevels;
begin
as_pm.ValueYellow:=REC_PM;
as_tmp.ValueYellow:=REC_TMP;
as_hum.ValueYellow:=REC_HUM;
as_co2.ValueYellow:=REC_CO2;
as_voc.ValueYellow:=REC_VOC;
as_allpollu.ValueYellow:=REC_ALLPOLLU;
end;
procedure Tmainform.UpdateHighLow(SensorNumber: integer);
begin
case SensorNumber of
@ -596,6 +626,7 @@ begin
ValueYellow := ValueMax;
if Value > ValueRed then
ValueRed := Value;
SetRecommendedLevels;
end;
end;