diff --git a/components/industrialstuff/Example/ButtonSamples/CMP_Button_Disa.png b/components/industrialstuff/Example/ButtonSamples/CMP_Button_Disa.png
new file mode 100644
index 000000000..0d5a54c87
Binary files /dev/null and b/components/industrialstuff/Example/ButtonSamples/CMP_Button_Disa.png differ
diff --git a/components/industrialstuff/Example/ButtonSamples/CMP_Button_Off.png b/components/industrialstuff/Example/ButtonSamples/CMP_Button_Off.png
new file mode 100644
index 000000000..0d5a54c87
Binary files /dev/null and b/components/industrialstuff/Example/ButtonSamples/CMP_Button_Off.png differ
diff --git a/components/industrialstuff/Example/ButtonSamples/CMP_Button_On.png b/components/industrialstuff/Example/ButtonSamples/CMP_Button_On.png
new file mode 100644
index 000000000..e6124be65
Binary files /dev/null and b/components/industrialstuff/Example/ButtonSamples/CMP_Button_On.png differ
diff --git a/components/industrialstuff/Example/Ex_IndustrialStuff.lpi b/components/industrialstuff/Example/Ex_IndustrialStuff.lpi
new file mode 100644
index 000000000..c6926d941
--- /dev/null
+++ b/components/industrialstuff/Example/Ex_IndustrialStuff.lpi
@@ -0,0 +1,105 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/industrialstuff/Example/Ex_IndustrialStuff.lpr b/components/industrialstuff/Example/Ex_IndustrialStuff.lpr
new file mode 100644
index 000000000..034654ad4
--- /dev/null
+++ b/components/industrialstuff/Example/Ex_IndustrialStuff.lpr
@@ -0,0 +1,21 @@
+program Ex_IndustrialStuff;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Interfaces, // this includes the LCL widgetset
+ Forms, u_industrial
+ { you can add units after this };
+
+{$R *.res}
+
+begin
+ RequireDerivedFormResource := True;
+ Application.Initialize;
+ Application.CreateForm(TForm1, Form1);
+ Application.Run;
+end.
+
diff --git a/components/industrialstuff/Example/Ex_IndustrialStuff.res b/components/industrialstuff/Example/Ex_IndustrialStuff.res
new file mode 100644
index 000000000..e66ecf85f
Binary files /dev/null and b/components/industrialstuff/Example/Ex_IndustrialStuff.res differ
diff --git a/components/industrialstuff/Example/u_industrial.lfm b/components/industrialstuff/Example/u_industrial.lfm
new file mode 100644
index 000000000..863780a96
--- /dev/null
+++ b/components/industrialstuff/Example/u_industrial.lfm
@@ -0,0 +1,134 @@
+object Form1: TForm1
+ Left = 123
+ Height = 166
+ Top = 95
+ Width = 568
+ Caption = 'IndustrialStuff Example'
+ ClientHeight = 166
+ ClientWidth = 568
+ LCLVersion = '1.1'
+ object indLed1: TindLed
+ Left = 200
+ Height = 35
+ Top = 33
+ Width = 34
+ LedValue = False
+ Bevels = <
+ item
+ HighlightColor = clBlack
+ ShadowColor = clBlack
+ end
+ item
+ Width = 3
+ end
+ item
+ Style = bcLowered
+ end
+ item
+ HighlightColor = clBlack
+ ShadowColor = clBlack
+ end>
+ LedColorOn = clLime
+ LedColorOff = clGreen
+ LedColorDisabled = 22963
+ ShapeLedColorOn = clGreen
+ ShapeLedColorOff = 16384
+ ShapeLedColorDisabled = 13416
+ end
+ object StopLightSensor1: TStopLightSensor
+ Left = 96
+ Height = 59
+ Top = 24
+ Width = 25
+ Center = True
+ Picture.Data = {
+ 1754506F727461626C654E6574776F726B47726170686963EF00000089504E47
+ 0D0A1A0A0000000D49484452000000150000002B08020000001805541C000000
+ B649444154789CED94010E84200C04FBF47B9A3FE304142AB5AD5B721763DCA0
+ 21C1D9D6BA919639D17A7DA24A296D3CE15AC11FF3ADCF089F5F8FA8AED3072C
+ 9EC39A85CA77389FAB161E5F15E7C5FA173F3B3F69017FBF6611CF8FABFBE7BF
+ DCFB1EE08FF0B985959F8A9523D5C2E22B9C7F6FAC0B8017CDE3F5A505967F1B
+ 76F8C1E2CD3FCEEFD363FBEB3C87350B277F54226C58983CCB7FB3C0F2CF2B47
+ EA4B0B2CFF36ECF083C5F3F3BF84B4F169427D48317D01F81FF539473C105700
+ 00000049454E44AE426082
+ }
+ State = slRED
+ end
+ object LEDNumber1: TLEDNumber
+ Left = 32
+ Height = 28
+ Top = 116
+ Width = 177
+ Caption = 'Lazarus'
+ OffColor = 930866
+ OnColor = clLime
+ end
+ object AnalogSensor1: TAnalogSensor
+ Left = 256
+ Height = 136
+ Top = 8
+ Width = 153
+ BorderWidth = 2
+ BorderStyle = bsSingle
+ Caption = 'level : '
+ ClientHeight = 132
+ ClientWidth = 149
+ Font.Height = -16
+ Font.Name = 'Arial'
+ ParentColor = False
+ ParentFont = False
+ TabOrder = 0
+ ShowText = True
+ ShowLevel = True
+ ColorFore = clLime
+ ColorBack = clBlack
+ Value = 20
+ ValueMin = 0
+ ValueMax = 100
+ ValueRed = 30
+ ValueYellow = 60
+ AnalogKind = akVertical
+ end
+ object indGnouMeter1: TindGnouMeter
+ Left = 424
+ Height = 129
+ Top = 17
+ Width = 120
+ Caption = 'indGnouMeter1'
+ Value = 70
+ Color = clPurple
+ ParentColor = False
+ ColorFore = clRed
+ ColorBack = clInactiveCaption
+ SignalUnit = 'Units'
+ ValueMin = 0
+ ValueMax = 100
+ Digits = 0
+ Increment = 10
+ ShowIncrements = True
+ Transparent = True
+ GapTop = 20
+ GapBottom = 10
+ BarThickness = 5
+ MarkerColor = clBlue
+ ShowMarker = True
+ end
+ object Arrow1: TArrow
+ Left = 48
+ Height = 20
+ Top = 41
+ Width = 20
+ Constraints.MinHeight = 8
+ Constraints.MinWidth = 8
+ end
+ object AdvLed1: TAdvLed
+ Left = 152
+ Height = 24
+ Top = 40
+ Width = 24
+ Kind = lkYellowLight
+ State = lsOn
+ Blink = False
+ AutoSize = True
+ end
+end
diff --git a/components/industrialstuff/Example/u_industrial.pas b/components/industrialstuff/Example/u_industrial.pas
new file mode 100644
index 000000000..f52ac4ddb
--- /dev/null
+++ b/components/industrialstuff/Example/u_industrial.pas
@@ -0,0 +1,39 @@
+unit u_industrial;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, SysUtils, FileUtil, IndLed, Sensors, LedNumber,
+ IndGnouMeter, AdvLed, Forms, Controls, Graphics, Dialogs, Arrow;
+
+type
+
+ { TForm1 }
+
+ TForm1 = class(TForm)
+ AdvLed1: TAdvLed;
+ AnalogSensor1: TAnalogSensor;
+ Arrow1: TArrow;
+ indGnouMeter1: TindGnouMeter;
+ indLed1: TindLed;
+ LEDNumber1: TLEDNumber;
+ StopLightSensor1: TStopLightSensor;
+ private
+
+ public
+
+ end;
+
+var
+ Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+end.
+
diff --git a/components/industrialstuff/industrial.lpk b/components/industrialstuff/industrial.lpk
new file mode 100644
index 000000000..8d5b2fa90
--- /dev/null
+++ b/components/industrialstuff/industrial.lpk
@@ -0,0 +1,95 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ <_ExternHelp Items="Count"/>
+
+
+
diff --git a/components/industrialstuff/industrial.pas b/components/industrialstuff/industrial.pas
new file mode 100644
index 000000000..1cff754a5
--- /dev/null
+++ b/components/industrialstuff/industrial.pas
@@ -0,0 +1,23 @@
+{ This file was automatically created by Lazarus. Do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit industrial;
+
+{$warn 5023 off : no warning about unused units}
+interface
+
+uses
+ IndLed, Sensors, AllIndustrialRegister, LedNumber, indGnouMeter, AdvLed,
+ indcyBaseLed, indcyClasses, indcyGraphics, indcyTypes, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('AllIndustrialRegister', @AllIndustrialRegister.Register);
+end;
+
+initialization
+ RegisterPackage('industrial', @Register);
+end.
diff --git a/components/industrialstuff/resources/black.png b/components/industrialstuff/resources/black.png
new file mode 100644
index 000000000..183962457
Binary files /dev/null and b/components/industrialstuff/resources/black.png differ
diff --git a/components/industrialstuff/resources/build.bat b/components/industrialstuff/resources/build.bat
new file mode 100644
index 000000000..bb2e2af88
--- /dev/null
+++ b/components/industrialstuff/resources/build.bat
@@ -0,0 +1,3 @@
+..\..\..\tools\lazres ..\source\sensors.res @sensors.txt
+..\..\..\tools\lazres ..\source\industrial_icons.res @industrial_icons.txt
+..\..\..\tools\lazres ..\source\ledbuttons.res @ledbuttons.txt
\ No newline at end of file
diff --git a/components/industrialstuff/resources/bulboff.xpm b/components/industrialstuff/resources/bulboff.xpm
new file mode 100644
index 000000000..79195063c
--- /dev/null
+++ b/components/industrialstuff/resources/bulboff.xpm
@@ -0,0 +1,34 @@
+/* XPM */
+static char * LEDBULBOFF[] = {
+"15 15 16 1",
+" c #000000",
+". c #800000",
+"+ c #008000",
+"@ c #808000",
+"# c #000080",
+"$ c #800080",
+"% c #008080",
+"& c #808080",
+"* c #C0C0C0",
+"= c #FF0000",
+"- c #00FF00",
+"; c #FFFF00",
+"> c #0000FF",
+", c #FF00FF",
+"' c #00FFFF",
+") c #FFFFFF",
+"@@@@@@@@@@@@@@@",
+"@@@@@@@@@@@@@@@",
+"@@@@@@@@@@@@@@@",
+"@@@@@@@@@@@@@@@",
+"@@@@@@ @@@@@@",
+"@@@@@ ))) @@@@@",
+"@@@@ ))))) @@@@",
+"@@@@ ))&)) @@@@",
+"@@@@ ))&)) @@@@",
+"@@@@@ )&) @@@@@",
+"@@@@@@ ) @@@@@@",
+"@@@@@@ ) @@@@@@",
+"@@@@@@ @@@@@@",
+"@@@@@@ * @@@@@@",
+"@@@@@@ @@@@@@"};
diff --git a/components/industrialstuff/resources/bulbon.xpm b/components/industrialstuff/resources/bulbon.xpm
new file mode 100644
index 000000000..03b48d3c9
--- /dev/null
+++ b/components/industrialstuff/resources/bulbon.xpm
@@ -0,0 +1,34 @@
+/* XPM */
+static char * LEDBULBON[] = {
+"15 15 16 1",
+" c #000000",
+". c #800000",
+"+ c #008000",
+"@ c #808000",
+"# c #000080",
+"$ c #800080",
+"% c #008080",
+"& c #808080",
+"* c #C0C0C0",
+"= c #FF0000",
+"- c #00FF00",
+"; c #FFFF00",
+"> c #0000FF",
+", c #FF00FF",
+"' c #00FFFF",
+") c #FFFFFF",
+"@@@@@@@;@@@@@@@",
+"@@@@@@@;@@@@@@@",
+"@@;@@;;;;;@@;@@",
+"@@@;;;;;;;;;@@@",
+"@@@;;; ;;;@@@",
+"@@;;; );) ;;;@@",
+"@@;; ););) ;;@@",
+";;;; ;)&); ;;;;",
+"@@;; );&;) ;;@@",
+"@@;;; )&) ;;;@@",
+"@@@;;; ) ;;;@@@",
+"@@@;;; ; ;;;@@@",
+"@@;@@; ;@@;@@",
+"@@@@@@ * @@@@@@",
+"@@@@@@ @@@@@@"};
diff --git a/components/industrialstuff/resources/green.png b/components/industrialstuff/resources/green.png
new file mode 100644
index 000000000..2a20ee074
Binary files /dev/null and b/components/industrialstuff/resources/green.png differ
diff --git a/components/industrialstuff/resources/industrial_icons.txt b/components/industrialstuff/resources/industrial_icons.txt
new file mode 100644
index 000000000..902790dc6
--- /dev/null
+++ b/components/industrialstuff/resources/industrial_icons.txt
@@ -0,0 +1,6 @@
+tadvled.png
+tanalogsensor.png
+tindgnoumeter.png
+tindled.png
+tlednumber.png
+tstoplightsensor.png
diff --git a/components/industrialstuff/resources/ledbuttons.txt b/components/industrialstuff/resources/ledbuttons.txt
new file mode 100644
index 000000000..382ab3a71
--- /dev/null
+++ b/components/industrialstuff/resources/ledbuttons.txt
@@ -0,0 +1,6 @@
+black.png
+green.png
+red.png
+yellow.png
+bulboff.xpm
+bulbon.xpm
diff --git a/components/industrialstuff/resources/red.png b/components/industrialstuff/resources/red.png
new file mode 100644
index 000000000..40081a2e0
Binary files /dev/null and b/components/industrialstuff/resources/red.png differ
diff --git a/components/industrialstuff/resources/sensors.txt b/components/industrialstuff/resources/sensors.txt
new file mode 100644
index 000000000..0f1a17407
--- /dev/null
+++ b/components/industrialstuff/resources/sensors.txt
@@ -0,0 +1,4 @@
+stop_green.png
+stop_red.png
+stop_unknown.png
+stop_yellow.png
\ No newline at end of file
diff --git a/components/industrialstuff/resources/stop_green.png b/components/industrialstuff/resources/stop_green.png
new file mode 100644
index 000000000..a8461f35a
Binary files /dev/null and b/components/industrialstuff/resources/stop_green.png differ
diff --git a/components/industrialstuff/resources/stop_red.png b/components/industrialstuff/resources/stop_red.png
new file mode 100644
index 000000000..8101a522d
Binary files /dev/null and b/components/industrialstuff/resources/stop_red.png differ
diff --git a/components/industrialstuff/resources/stop_unknown.png b/components/industrialstuff/resources/stop_unknown.png
new file mode 100644
index 000000000..e4aa10571
Binary files /dev/null and b/components/industrialstuff/resources/stop_unknown.png differ
diff --git a/components/industrialstuff/resources/stop_yellow.png b/components/industrialstuff/resources/stop_yellow.png
new file mode 100644
index 000000000..9d4fbe943
Binary files /dev/null and b/components/industrialstuff/resources/stop_yellow.png differ
diff --git a/components/industrialstuff/resources/tadvled.png b/components/industrialstuff/resources/tadvled.png
new file mode 100644
index 000000000..2a20ee074
Binary files /dev/null and b/components/industrialstuff/resources/tadvled.png differ
diff --git a/components/industrialstuff/resources/tanalogsensor.png b/components/industrialstuff/resources/tanalogsensor.png
new file mode 100644
index 000000000..eda94eb1a
Binary files /dev/null and b/components/industrialstuff/resources/tanalogsensor.png differ
diff --git a/components/industrialstuff/resources/tindadvled.png b/components/industrialstuff/resources/tindadvled.png
new file mode 100644
index 000000000..fd199cb4f
Binary files /dev/null and b/components/industrialstuff/resources/tindadvled.png differ
diff --git a/components/industrialstuff/resources/tindgnoumeter.png b/components/industrialstuff/resources/tindgnoumeter.png
new file mode 100644
index 000000000..d65a7f5e8
Binary files /dev/null and b/components/industrialstuff/resources/tindgnoumeter.png differ
diff --git a/components/industrialstuff/resources/tindled.png b/components/industrialstuff/resources/tindled.png
new file mode 100644
index 000000000..82cdb5ed9
Binary files /dev/null and b/components/industrialstuff/resources/tindled.png differ
diff --git a/components/industrialstuff/resources/tlednumber.png b/components/industrialstuff/resources/tlednumber.png
new file mode 100644
index 000000000..02be83846
Binary files /dev/null and b/components/industrialstuff/resources/tlednumber.png differ
diff --git a/components/industrialstuff/resources/tstoplightsensor.png b/components/industrialstuff/resources/tstoplightsensor.png
new file mode 100644
index 000000000..d7c60a1f1
Binary files /dev/null and b/components/industrialstuff/resources/tstoplightsensor.png differ
diff --git a/components/industrialstuff/resources/yellow.png b/components/industrialstuff/resources/yellow.png
new file mode 100644
index 000000000..a801b5d05
Binary files /dev/null and b/components/industrialstuff/resources/yellow.png differ
diff --git a/components/industrialstuff/source/AdvLed.pas b/components/industrialstuff/source/AdvLed.pas
new file mode 100644
index 000000000..da4b00194
--- /dev/null
+++ b/components/industrialstuff/source/AdvLed.pas
@@ -0,0 +1,330 @@
+(******************************************************
+ AdvLed by Jurassic Pork 2013 for Lazarus
+ created from TComled of ComPort Library ver. 3.00
+ written by Dejan Crnila, 1998 - 2002
+ email: dejancrn@yahoo.com
+ ****************************************************************************
+ This file is part of Lazarus
+
+ See the file COPYING.modifiedLGPL.txt, included in this distribution,
+ for details about the license.
+ ****************************************************************************
+ Unit: AdvLed.pas
+ ******************************************************)
+
+unit AdvLed;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLType, Classes, ExtCtrls, Controls, Graphics;
+
+type
+
+ // property types
+ TLedBitmap = Graphics.TPicture;
+// TLedKind = (lkRedLight, lkGreenLight, lkBlueLight, lkYellowLight, lkPurpleLight, lkBulb, lkCustom);
+ TLedKind = (lkRedLight, lkGreenLight, lkYellowLight, lkBulb, lkCustom);
+ TLedState = (lsDisabled, lsOff, lsOn);
+ TAdvLedGlyphs = array[TLedState] of TLedBitmap;
+ TLedStateEvent = procedure(Sender: TObject; AState: TLedState) of object;
+
+ // led control that shows the state of serial signals
+ TAdvLed = class(TCustomImage)
+ private
+ FKind: TLedKind;
+ FState: TLedState;
+ FBlink: Boolean;
+ FOnChange: TLedStateEvent;
+ FGlyphs: TAdvLedGlyphs;
+ FBlinkTimer: TTimer;
+ function GetGlyph(const Index: Integer): TLedBitmap;
+ function GetBlinkDuration: Integer;
+ procedure SetKind(const Value: TLedKind);
+ procedure SetState(const Value: TLedState);
+ procedure SetGlyph(const Index: Integer; const Value: TLedBitmap);
+ procedure SetBlinkDuration(const Value: Integer);
+ procedure SetBlink(const Value: Boolean);
+ function StoredGlyph(const Index: Integer): Boolean;
+ procedure SelectLedBitmap(const LedKind: TLedKind);
+ function BitmapToDraw: TLedBitmap;
+ procedure BitmapNeeded;
+ procedure DoTimer(Sender: TObject);
+ procedure GlyphChanged(Sender: TObject);
+
+ protected
+ FlipFLop : Boolean;
+ procedure DoChange(AState: TLedState); dynamic;
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ published
+ // kind property must be published before GlyphOn, GlyphOff,GlyphDisable
+ property Kind: TLedKind read FKind write SetKind default lkRedLight;
+ property GlyphDisabled: TLedBitmap index 0 read GetGlyph
+ write SetGlyph stored StoredGlyph;
+ property GlyphOff: TLedBitmap index 1 read GetGlyph
+ write SetGlyph stored StoredGlyph;
+ property GlyphOn: TLedBitmap index 2 read GetGlyph
+ write SetGlyph stored StoredGlyph;
+ property State: TLedState read FState write SetState;
+ property Blink: Boolean read FBlink write SetBlink;
+ property BlinkDuration: Integer read GetBlinkDuration write SetBlinkDuration default 1000;
+ property Align;
+ property AutoSize default true;
+ property Center;
+ property Constraints;
+// property Picture;
+ property Visible;
+ property OnClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property Stretch;
+ property Showhint;
+ property Transparent;
+ property Proportional;
+ property OnPictureChanged;
+ property OnChange: TLedStateEvent read FOnChange write FOnChange;
+
+ { property Align;
+ property DragCursor;
+ property DragMode;
+ property Enabled;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property Visible;
+ property Anchors;
+ property Constraints;
+ property DragKind;
+ property ParentBiDiMode;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDrag;
+ property OnEndDock;
+ property OnResize;
+ property OnStartDock;
+ property OnContextPopup; }
+ end;
+
+implementation
+
+{$R ledbuttons.res}
+
+(*****************************************
+ * auxilary functions *
+ *****************************************)
+
+function Min(A, B: Integer): Integer;
+begin
+ if A < B then
+ Result := A
+ else
+ Result := B;
+end;
+
+function Max(A, B: Integer): Integer;
+begin
+ if A > B then
+ Result := A
+ else
+ Result := B;
+end;
+(*****************************************
+ * TAdvLed control *
+ *****************************************)
+
+// create control
+constructor TAdvLed.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle - [csSetCaption];
+ AutoSize:=True;
+ FGlyphs[lsOn] := TLedBitmap.Create;
+ FGlyphs[lsOff] := TLedBitmap.Create;
+ FGlyphs[lsDisabled] := TLedBitmap.Create;
+ FGlyphs[lsOn].OnChange:= @GlyphChanged;
+ FGlyphs[lsOff].OnChange:= @GlyphChanged;
+ FGlyphs[lsDisabled].OnChange:= @GlyphChanged;
+ FBlinkTimer := TTimer.Create(nil);
+ FBlinkTimer.OnTimer := @DoTimer;
+ FBlinkTimer.Enabled := false;
+ if (csDesigning in ComponentState) then BitmapNeeded;
+end;
+
+// destroy control
+destructor TAdvLed.Destroy;
+begin
+ FBlinkTimer.Free;
+ FGlyphs[lsOn].Free;
+ FGlyphs[lsOff].Free;
+ FGlyphs[lsDisabled].Free;
+ inherited Destroy;
+end;
+
+// loaded
+procedure TAdvLed.Loaded;
+ begin
+ Try
+ If (csDesigning in ComponentState) Then Exit ;
+ // Load Bitmap if necessary
+ BitmapNeeded;
+ Finally
+ inherited Loaded;
+ End;
+end;
+
+// timer
+procedure TAdvLed.DoTimer(Sender: TObject);
+begin
+ if FlipFlop then
+ SetState(lsOn )
+ else
+ SetState(lsoff);
+ FlipFlop := Not FlipFlop;
+end;
+
+// trigger OnChangeEvent
+procedure TAdvLed.DoChange(AState: TLedState);
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self, AState);
+ invalidate;
+end;
+
+// if bitmap is empty, load it
+procedure TAdvLed.BitmapNeeded;
+begin
+ if (FGlyphs[lsOn].Bitmap.Empty) or (FGlyphs[lsOff].Bitmap.Empty) or
+ (FGlyphs[lsDisabled].Bitmap.Empty) then
+ begin
+ SelectLedBitmap(FKind);
+ Picture.Assign(BitmapToDraw);
+ end;
+end;
+
+procedure TAdvLed.SelectLedBitmap(const LedKind: TLedKind);
+const
+{ OnBitmaps: array[TLedKind] of string = ('LEDREDON', 'LEDGREENON', 'LEDBLUEON',
+ 'LEDYELLOWON', 'LEDPURPLEON', 'LEDBULBON', '');
+ OffBitmaps: array[TLedKind] of string = ('LEDREDOFF', 'LEDGREENOFF',
+ 'LEDBLUEOFF', 'LEDYELLOWOFF', 'LEDPURPLEOFF', 'LEDBULBOFF' ,'');
+ DisabledBitmaps: array[TLedKind] of string = ('LEDREDOFF', 'LEDGREENOFF',
+ 'LEDBLUEOFF', 'LEDYELLOWOFF', 'LEDPURPLEOFF', 'LEDBULBOFF' ,''); }
+ OnBitmaps: array[TLedKind] of string = ('RED', 'GREEN', 'YELLOW', 'BULBON', '');
+ OffBitmaps: array[TLedKind] of string = ('BLACK', 'BLACK', 'BLACK','BULBOFF', '');
+ DisabledBitmaps: array[TLedKind] of string = ('BLACK', 'BLACK', 'BLACK','BULBOFF' ,'');
+begin
+ if LedKind <> lkCustom then
+ begin
+ FGlyphs[lsOn].LoadFromResourceName(HInstance, OnBitmaps[LedKind]);
+ FGlyphs[lsOff].LoadFromResourceName(HInstance, OffBitmaps[LedKind]);
+ FGlyphs[lsDisabled].LoadFromResourceName(HInstance, DisabledBitmaps[LedKind]);
+ end;
+end;
+
+// set led kind
+procedure TAdvLed.SetKind(const Value: TLedKind);
+begin
+ if FKind <> Value then
+ begin
+ FKind := Value;
+ SelectLedBitmap(FKind);
+ Picture.Assign(BitmapToDraw);
+ end;
+end;
+
+// set led state
+procedure TAdvLed.SetState(const Value: TLedState);
+begin
+ FState := Value;
+ if not (csLoading in ComponentState) then
+ DoChange(FState);
+ Picture.Assign(BitmapToDraw);
+end;
+
+function TAdvLed.GetGlyph(const Index: Integer): TLedBitmap;
+begin
+ case Index of
+ 0: Result := FGlyphs[lsDisabled];
+ 1: Result := FGlyphs[lsOff];
+ 2: Result := FGlyphs[lsOn];
+ else
+ Result := nil;
+ end;
+end;
+
+procedure TAdvLed.GlyphChanged(Sender: TObject );
+begin
+// if (csDesigning in ComponentState) then Picture.Assign(Sender as TPicture);
+ if (csDesigning in ComponentState) then
+ begin
+ if Sender = FGlyphs[lsDisabled] then FState := lsDisabled;
+ if Sender = FGlyphs[lsOff] then FState := lsOff;
+ if Sender = FGlyphs[lsOn] then FState := lsOn;
+ Picture.Assign(Sender as TPicture);
+ end;
+end;
+
+// set custom bitmap
+procedure TAdvLed.SetGlyph(const Index: Integer; const Value: TLedBitmap);
+begin
+ if FKind = lkCustom then
+ begin
+ case Index of
+ 0: FGlyphs[lsDisabled].Assign(Value);
+ 1: FGlyphs[lsOff].Assign(Value);
+ 2: FGlyphs[lsOn].Assign(Value);
+ end;
+ end;
+ Picture.Assign(BitmapToDraw);
+end;
+
+function TAdvLed.StoredGlyph(const Index: Integer): Boolean;
+begin
+ Result := FKind = lkCustom;
+end;
+
+// get bitmap for drawing
+function TAdvLed.BitmapToDraw: TLedBitmap;
+var
+ ToDraw: TLedState;
+begin
+ if not Enabled then
+ ToDraw := lsOff
+ else
+ ToDraw := FState;
+ Result := FGlyphs[ToDraw];
+end;
+
+function TAdvLed.GetBlinkDuration: Integer;
+begin
+ Result := FBlinkTimer.Interval;
+end;
+
+procedure TAdvLed.SetBlinkDuration(const Value: Integer);
+begin
+ FBlinkTimer.Interval := Value;
+end;
+
+// set led blink
+procedure TAdvLed.SetBlink(const Value: Boolean);
+begin
+ FBlink :=Value;
+ if (csDesigning in ComponentState) then Exit;
+ FBlinkTimer.Enabled := FBlink;
+end;
+
+end.
diff --git a/components/industrialstuff/source/AllIndustrialRegister.pas b/components/industrialstuff/source/AllIndustrialRegister.pas
new file mode 100644
index 000000000..ce61cd119
--- /dev/null
+++ b/components/industrialstuff/source/AllIndustrialRegister.pas
@@ -0,0 +1,30 @@
+
+{**********************************************************************
+ Package industrial Lazarus
+
+ This unit is part of Lazarus Project
+***********************************************************************}
+
+unit AllIndustrialRegister;
+
+interface
+
+
+ uses
+ Classes, LResources, AdvLed, IndLed, LedNumber, Sensors, IndGnouMeter;
+
+procedure Register;
+
+implementation
+
+{$R industrial_icons.res}
+
+//==========================================================
+procedure Register;
+begin
+ RegisterComponents ('Industrial',[
+ TAdvLed, TIndLed, TLedNumber, TStopLightSensor, TAnalogSensor, TindGnouMeter]);
+
+end;
+
+end.
diff --git a/components/industrialstuff/source/indcyBaseLed.pas b/components/industrialstuff/source/indcyBaseLed.pas
new file mode 100644
index 000000000..94815f0b9
--- /dev/null
+++ b/components/industrialstuff/source/indcyBaseLed.pas
@@ -0,0 +1,228 @@
+{ Component(s):
+ tcyBaseLed
+
+ Description:
+ A base led component with Group feature
+ Led states : ON/OFF/DISABLE
+
+ * ***** BEGIN LICENSE BLOCK *****
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with the
+ * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * The Initial Developer of the Original Code is Mauricio
+ * (https://sourceforge.net/projects/tcycomponents/).
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or the
+ * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
+ * case the provisions of the GPL or the LGPL are applicable instead of those
+ * above. If you wish to allow use of your version of this file only under the
+ * terms of either the GPL or the LGPL, and not to allow others to use your
+ * version of this file under the terms of the MPL, indicate your decision by
+ * deleting the provisions above and replace them with the notice and other
+ * provisions required by the LGPL or the GPL. If you do not delete the
+ * provisions above, a recipient may use your version of this file under the
+ * terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK *****}
+
+unit indcyBaseLed;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses LCLIntf, LCLType, LMessages, Messages, Classes, Types, Controls, Graphics;
+
+type
+ TLedStatus = (lsOn, lsOff, lsDisabled);
+
+ TcyBaseLed = class(TGraphicControl)
+ private
+ FGroupIndex: Integer;
+ FAllowAllOff: Boolean;
+ FLedValue: Boolean;
+ FReadOnly: Boolean;
+ procedure SetAllowAllOff(Value: Boolean);
+ procedure SetGroupIndex(Value: Integer);
+ procedure UpdateExclusive;
+ protected
+ procedure Click; override;
+ procedure Loaded; override;
+ procedure SetEnabled(Value: Boolean); override;
+ procedure CMButtonPressed(var Message: TLMessage); message CM_BUTTONPRESSED; // Called in UpdateExclusive procedure ...
+ function TransparentColorAtPos(Point: TPoint): boolean; virtual;
+ procedure LedStatusChanged; virtual;
+ procedure SetInternalLedValue(Value: Boolean);
+ function GetLedStatus: TLedStatus; virtual;
+ procedure SetLedvalue(Value: Boolean); virtual;
+ procedure SetReadOnly(AValue: Boolean); virtual;
+ property AllowAllOff: Boolean read FAllowAllOff write SetAllowAllOff default false;
+ property GroupIndex: Integer read FGroupIndex write SetGroupIndex default 0;
+ property LedValue: Boolean read FLedvalue write SetLedvalue;
+ property ReadOnly: Boolean read FReadOnly write SetReadOnly default false;
+ public
+ property Canvas;
+ constructor Create(AOwner: TComponent); override;
+ property LedStatus: TLedStatus read GetLedStatus;
+ procedure Switch;
+ published
+ end;
+
+implementation
+
+constructor TcyBaseLed.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FAllowAllOff := false;
+ FGroupIndex := 0;
+ FLedvalue:= false;
+ FReadOnly := false;
+end;
+
+procedure TcyBaseLed.LedStatusChanged;
+begin
+ Invalidate;
+end;
+
+procedure TcyBaseLed.Loaded;
+begin
+ Inherited;
+ ControlStyle := ControlStyle - [csDoubleClicks];
+end;
+
+procedure TcyBaseLed.SetReadOnly(AValue: Boolean);
+begin
+ if AValue <> FReadOnly
+ then FReadOnly := AValue;
+end;
+
+procedure TcyBaseLed.SetEnabled(Value: Boolean);
+begin
+ Inherited;
+ LedStatusChanged;
+end;
+
+function TcyBaseLed.TransparentColorAtPos(Point: TPoint): boolean;
+begin
+ RESULT := false;
+end;
+
+procedure TcyBaseLed.Click;
+var aPt: TPoint;
+begin
+ if not FReadOnly
+ then begin
+ GetCursorPos(aPt);
+ aPt := Self.ScreenToClient(aPt);
+
+ if Not TransparentColorAtPos(aPt)
+ then LedValue := not FLedValue;
+ end;
+
+ Inherited;
+end;
+
+function TcyBaseLed.GetLedStatus: TLedStatus;
+begin
+ if not Enabled
+ then
+ RESULT := lsDisabled
+ else
+ if FLedValue
+ then RESULT := lsOn
+ else RESULT := lsOff;
+end;
+
+// Procedure to force changing value :
+procedure TcyBaseLed.SetInternalLedValue(Value: Boolean);
+begin
+ if FLedValue <> Value
+ then begin
+ FLedValue := Value;
+ LedStatusChanged;
+ end;
+end;
+
+procedure TcyBaseLed.Switch;
+begin
+ LedValue := not FLedValue;
+end;
+
+procedure TcyBaseLed.SetLedvalue(Value: Boolean);
+begin
+ if Value <> FLedvalue
+ then begin
+ if (not Value) and (not FAllowAllOff) and (FGroupIndex <> 0)
+ then Exit; // Can't turn off all leds of the same group ...
+
+ FLedvalue := Value;
+ LedStatusChanged;
+
+ if Value
+ then UpdateExclusive; // Send message to turn off the other one ...
+ end;
+end;
+
+procedure TcyBaseLed.SetAllowAllOff(Value: Boolean);
+begin
+ if FAllowAllOff <> Value
+ then begin
+ FAllowAllOff := Value;
+ UpdateExclusive; // Inform FAllowAllOff value to the others from the same group
+ end;
+end;
+
+procedure TcyBaseLed.SetGroupIndex(Value: Integer);
+begin
+ if FGroupIndex <> Value
+ then begin
+ FGroupIndex := Value;
+ UpdateExclusive;
+ end;
+end;
+
+procedure TcyBaseLed.UpdateExclusive;
+var
+ Msg: TMessage;
+begin
+ if (FGroupIndex <> 0) and (Parent <> nil)
+ then begin
+ Msg.Msg := CM_BUTTONPRESSED;
+ Msg.WParam := FGroupIndex;
+ Msg.LParam := PtrInt(Self);
+ Msg.Result := 0;
+ Parent.Broadcast(Msg);
+ end;
+end;
+
+procedure TcyBaseLed.CMButtonPressed(var Message: TLMessage);
+var Sender: TcyBaseLed;
+begin
+ if (csLoading in ComponentState) then exit;
+
+ if Message.WParam = FGroupIndex // Same group?
+ then begin
+ Sender := TcyBaseLed(Message.LParam);
+ if Sender <> Self
+ then begin
+ if Sender.LedValue and FLedValue // Only one can be turn on on group mode ...
+ then begin;
+ FLedValue := false;
+ LedStatusChanged;
+ end;
+
+ FAllowAllOff := Sender.AllowAllOff;
+ end;
+ end;
+end;
+
+end.
diff --git a/components/industrialstuff/source/indcyClasses.pas b/components/industrialstuff/source/indcyClasses.pas
new file mode 100644
index 000000000..e5c01b5a8
--- /dev/null
+++ b/components/industrialstuff/source/indcyClasses.pas
@@ -0,0 +1,307 @@
+{ Unit indcyClasses from cyClasses
+
+ Description:
+ Unit with sub-properties for components.
+
+
+ * ***** BEGIN LICENSE BLOCK *****
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with the
+ * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * The Initial Developer of the Original Code is Mauricio
+ * (https://sourceforge.net/projects/tcycomponents/).
+ *
+ * No contributors for now ...
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or the
+ * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
+ * case the provisions of the GPL or the LGPL are applicable instead of those
+ * above. If you wish to allow use of your version of this file only under the
+ * terms of either the GPL or the LGPL, and not to allow others to use your
+ * version of this file under the terms of the MPL, indicate your decision by
+ * deleting the provisions above and replace them with the notice and other
+ * provisions required by the LGPL or the GPL. If you do not delete the
+ * provisions above, a recipient may use your version of this file under the
+ * terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK *****}
+
+unit indcyClasses;
+
+{$mode objfpc}{$H+}
+
+// {$I cyCompilerDefines.inc}
+
+interface
+
+uses
+ LCLIntf, Classes, Graphics, Controls, SysUtils,
+ indcyTypes, indcyGraphics;
+
+type
+ tcyBevel = class(TCollectionItem)
+ private
+ FHighlightColor: TColor;
+ FShadowColor: TColor;
+ FWidth: Word;
+ FStyle: TcyBevelCut;
+ FDrawRight: Boolean;
+ FDrawLeft: Boolean;
+ FDrawTop: Boolean;
+ FDrawBottom: Boolean;
+ FNeedOwnerRealign: Boolean;
+ procedure SetHighlightColor(const Value: TColor);
+ procedure SetShadowColor(const Value: TColor);
+ procedure SetWidth(const Value: Word);
+ procedure SetStyle(const Value: TcyBevelCut);
+ procedure SetDrawBottom(const Value: Boolean);
+ procedure SetDrawLeft(const Value: Boolean);
+ procedure SetDrawRight(const Value: Boolean);
+ procedure SetDrawTop(const Value: Boolean);
+ protected
+ function GetDisplayName: string; override;
+ public
+ constructor Create(ACollection: TCollection); override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property DrawLeft: Boolean read FDrawLeft write SetDrawLeft default True;
+ property DrawTop: Boolean read FDrawTop write SetDrawTop default True;
+ property DrawRight: Boolean read FDrawRight write SetDrawRight default True;
+ property DrawBottom: Boolean read FDrawBottom write SetDrawBottom default True;
+ property HighlightColor: TColor read FHighlightColor write SetHighlightColor default clBtnHighlight;
+ property ShadowColor: TColor read FShadowColor write SetShadowColor default clBtnShadow;
+ property Style: TcyBevelCut read FStyle write SetStyle default bcRaised;
+ property Width: Word read FWidth write SetWidth default 1;
+ end;
+
+ TcyBevelClass = class of tcyBevel;
+
+ tcyBevels = Class(TCollection)
+ private
+ FControl: TControl;
+ FOnChange: TNotifyEvent;
+ FNeedOwnerRealign: Boolean;
+ function GetBevel(Index: Integer): TcyBevel;
+ protected
+ function GetOwner: TPersistent; Override;
+ procedure Update(Item: TCollectionItem); Override;
+ public
+ constructor Create(aControl: TControl; BevelClass: TcyBevelClass);
+ function Add: TcyBevel;
+ procedure Delete(Index: Integer);
+ procedure DrawBevels(aCanvas: TCanvas; var BoundsRect: TRect; RoundRect: Boolean);
+ function xBevelsWidth: Integer;
+ function BevelsWidth: Integer;
+ property Items[Index: Integer]: TcyBevel read GetBevel; default;
+ property NeedOwnerRealign: Boolean read FNeedOwnerRealign;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+implementation
+
+{ tcyBevel }
+procedure tcyBevel.Assign(Source: TPersistent);
+begin
+ if Source is tcyBevel then
+ begin
+ FHighlightColor := tcyBevel(Source).FHighlightColor;
+ FShadowColor := tcyBevel(Source).FShadowColor;
+ FWidth := tcyBevel(Source).FWidth;
+ FStyle := tcyBevel(Source).FStyle;
+ FDrawRight := tcyBevel(Source).FDrawRight;
+ FDrawLeft := tcyBevel(Source).FDrawLeft;
+ FDrawTop := tcyBevel(Source).FDrawTop;
+ FDrawBottom := tcyBevel(Source).FDrawBottom;
+ end;
+// inherited Assign(Source);
+end;
+
+constructor tcyBevel.Create(ACollection: TCollection);
+begin
+ inherited Create(ACollection);
+ FHighlightColor := clBtnHighlight;
+ FShadowColor := clBtnShadow;
+ FWidth := 1;
+ FStyle := bcRaised;
+ FDrawLeft := true;
+ FDrawTop := true;
+ FDrawRight := true;
+ FDrawBottom := true;
+ FNeedOwnerRealign := true;
+end;
+
+function tcyBevel.GetDisplayName: string;
+begin
+ case FStyle of
+ bcLowered: Result := 'Lowered';
+ bcRaised: Result := 'Raised';
+ bcNone: Result := 'None';
+ bcTransparent: Result := 'Transparent';
+ end;
+
+ Result := Result + ' Bevel';
+ Result := Result + ' Width = ' + intToStr(FWidth);
+end;
+
+procedure tcyBevel.SetDrawBottom(const Value: Boolean);
+begin
+ FDrawBottom := Value;
+ Changed(false); // It will call TcyBevels.Update !
+end;
+
+procedure tcyBevel.SetDrawLeft(const Value: Boolean);
+begin
+ FDrawLeft := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetDrawRight(const Value: Boolean);
+begin
+ FDrawRight := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetDrawTop(const Value: Boolean);
+begin
+ FDrawTop := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetHighlightColor(const Value: TColor);
+begin
+ FHighlightColor := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetShadowColor(const Value: TColor);
+begin
+ FShadowColor := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetStyle(const Value: TcyBevelCut);
+begin
+ if FStyle = Value then EXIT;
+
+ if (FStyle = bcNone) or (Value = bcNone)
+ then FNeedOwnerRealign := true;
+
+ FStyle := Value;
+ Changed(false);
+end;
+
+procedure tcyBevel.SetWidth(const Value: Word);
+begin
+ if FWidth = Value then EXIT;
+
+ FWidth := Value;
+ FNeedOwnerRealign := true;
+ Changed(false);
+end;
+
+{TcyBevels}
+constructor TcyBevels.Create(aControl: TControl; BevelClass: TcyBevelClass);
+begin
+ inherited Create(BevelClass);
+ FControl := aControl;
+ FNeedOwnerRealign := false;
+end;
+
+function TcyBevels.GetBevel(Index: Integer): TcyBevel;
+begin
+ Result := TcyBevel(inherited Items[Index]);
+end;
+
+function TcyBevels.GetOwner: TPersistent;
+begin
+ Result := FControl;
+end;
+
+// Event Called by setting properties/events of TcyBevel :
+procedure TcyBevels.Update(Item: TCollectionItem);
+begin
+ Inherited;
+ if Assigned(FOnChange)
+ then begin
+ if Item <> nil
+ then
+ if TcyBevel(Item).FNeedOwnerRealign
+ then begin
+ FNeedOwnerRealign := true;
+ TcyBevel(Item).FNeedOwnerRealign := false;
+ end;
+
+ FOnChange(Self);
+ FNeedOwnerRealign := false;
+ end
+ else
+ FControl.Invalidate;
+end;
+
+function TcyBevels.Add: TcyBevel;
+begin
+ Result := TcyBevel(inherited Add);
+ Result.Changed(false); // It will call TcyBevels.Update only at run-time!
+end;
+
+procedure TcyBevels.Delete(Index: Integer);
+begin
+ Inherited;
+ FNeedOwnerRealign := true;
+ Update(Nil);
+end;
+
+procedure TcyBevels.DrawBevels(aCanvas: TCanvas; var BoundsRect: TRect; RoundRect: Boolean);
+var i: Integer;
+begin
+ for i := 0 to Count-1 do
+ case Items[i].FStyle of
+ bcRaised:
+ begin
+ cyFrame3D(aCanvas, BoundsRect, Items[i].FHighlightColor, Items[i].FShadowColor, Items[i].FWidth,
+ Items[i].FDrawLeft, Items[i].FDrawTop, Items[i].FDrawRight, Items[i].FDrawBottom, RoundRect);
+ RoundRect := false;
+ end;
+
+ bcLowered:
+ begin
+ cyFrame3D(aCanvas, BoundsRect, Items[i].FShadowColor, Items[i].FHighlightColor, Items[i].FWidth,
+ Items[i].FDrawLeft, Items[i].FDrawTop, Items[i].FDrawRight, Items[i].FDrawBottom, RoundRect);
+ RoundRect := false;
+ end;
+
+ bcTransparent: // Just Inflate Rect
+ begin
+ InflateRect(BoundsRect, (-1) * Items[i].FWidth, (-1) * Items[i].FWidth);
+ RoundRect := false;
+ end;
+
+ bcNone: ;
+ end;
+end;
+
+function TcyBevels.xBevelsWidth: Integer;
+begin
+ RESULT := 0;
+end;
+
+// 9999 for All other units like TcySimpleGauge
+function TcyBevels.BevelsWidth: Integer;
+var i: Integer;
+begin
+ RESULT := 0;
+ for i := 0 to Count-1 do
+ if Items[i].FStyle <> bcNone
+ then Inc(RESULT, Items[i].FWidth);
+end;
+
+end.
diff --git a/components/industrialstuff/source/indcyGraphics.pas b/components/industrialstuff/source/indcyGraphics.pas
new file mode 100644
index 000000000..de0678ac8
--- /dev/null
+++ b/components/industrialstuff/source/indcyGraphics.pas
@@ -0,0 +1,198 @@
+{ Unit indcyGraphics from cyGraphics
+
+ Description:
+ Unit with graphic functions
+
+ * ***** BEGIN LICENSE BLOCK *****
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with the
+ * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * The Initial Developer of the Original Code is Mauricio
+ * (https://sourceforge.net/projects/tcycomponents/).
+ *
+ * No contributors for now ...
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or the
+ * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
+ * case the provisions of the GPL or the LGPL are applicable instead of those
+ * above. If you wish to allow use of your version of this file only under the
+ * terms of either the GPL or the LGPL, and not to allow others to use your
+ * version of this file under the terms of the MPL, indicate your decision by
+ * deleting the provisions above and replace them with the notice and other
+ * provisions required by the LGPL or the GPL. If you do not delete the
+ * provisions above, a recipient may use your version of this file under the
+ * terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK *****}
+
+unit indcyGraphics;
+
+{$mode objfpc}{$H+}
+
+// {$I cyCompilerDefines.inc}
+
+interface
+
+// We need to put jpeg to the uses for avoid run-time not handled jpeg image ...
+uses
+ LCLIntf, LCLType, Types, Classes, Forms, Graphics, Math, Buttons, Controls,
+ ExtCtrls, SysUtils, indcyTypes;
+
+// Objects painting functions :
+procedure cyFrame3D(Canvas: TCanvas; var Rect: TRect; TopLeftColor, BottomRightColor: TColor; Width: Integer;
+ const DrawLeft: Boolean = true; const DrawTop: Boolean = true; const DrawRight: Boolean = true; const DrawBottom: Boolean = true;
+ const RoundRect: boolean = false);
+
+// TPicture and TGraphic functions:
+function PictureIsTransparentAtPos(aPicture: TPicture; aPoint: TPoint): boolean;
+function IconIsTransparentAtPos(aIcon: TIcon; aPoint: TPoint): boolean;
+function ValidGraphic(aGraphic: TGraphic): Boolean;
+
+// Other functions:
+function PointInEllipse(const aPt: TPoint; const aRect: TRect): boolean;
+
+implementation
+
+{ Procedures and functions}
+
+procedure cyFrame3D(Canvas: TCanvas; var Rect: TRect; TopLeftColor, BottomRightColor: TColor; Width: Integer;
+ const DrawLeft: Boolean = true; const DrawTop: Boolean = true; const DrawRight: Boolean = true; const DrawBottom: Boolean = true;
+ const RoundRect: boolean = false);
+var incValue: Integer;
+
+ procedure DrawLines;
+ begin
+ with Canvas, Rect do
+ begin
+ // Draw Left and Top line :
+ Pen.Color := TopLeftColor;
+
+ if DrawLeft
+ then begin
+ MoveTo(Left, Top + incValue);
+ LineTo(Left, Bottom);
+ end;
+
+ if DrawTop
+ then begin
+ MoveTo(Left + incValue, Top);
+ LineTo(Right, Top);
+ end;
+
+ // Draw right and bottom line :
+ Pen.Color := BottomRightColor;
+
+ if DrawRight
+ then begin
+ MoveTo(Right, Top + incValue);
+ LineTo(Right, Bottom);
+ end;
+
+ if DrawBottom
+ then begin
+ MoveTo(Right - incValue, Bottom);
+ LineTo(Left-1 + incValue, Bottom);
+ end;
+ end;
+ end;
+
+begin
+ if RoundRect
+ then incValue := 1
+ else incValue := 0;
+
+ Canvas.Pen.Width := 1;
+ Dec(Rect.Bottom);
+ Dec(Rect.Right);
+
+ while Width > 0 do
+ begin
+ Dec(Width);
+ DrawLines;
+ incValue := 0;
+ InflateRect(Rect, -1, -1);
+ end;
+
+ Inc(Rect.Bottom);
+ Inc(Rect.Right);
+end;
+
+function PointInEllipse(const aPt: TPoint; const aRect: TRect): boolean;
+var
+ CenterEllipseCoord: TPoint;
+ EllipseWidth, EllipseHeight: Integer;
+begin
+ CenterEllipseCoord := Point((aRect.Right + aRect.Left) div 2, (aRect.Bottom + aRect.Top) div 2);
+ EllipseWidth := (aRect.Right - aRect.Left) div 2;
+ EllipseHeight := (aRect.Bottom - aRect.Top) div 2;
+
+ RESULT := Sqr((aPt.x - CenterEllipseCoord.x)/EllipseWidth) + Sqr((aPt.y - CenterEllipseCoord.y)/EllipseHeight)
+ <= 1;
+ // = 0 On the center of ellipse
+ // < 1 Inside the ellipse
+ // = on the border of ellipse
+ // > 1 Outside the ellipse
+end;
+
+function PictureIsTransparentAtPos(aPicture: TPicture; aPoint: TPoint): boolean;
+begin
+ RESULT := false; // TJPEGImage and others formats not handled ...
+ if aPicture.Graphic = nil then Exit;
+ if aPicture.Graphic.Empty then Exit;
+
+ if aPicture.Graphic is TBitmap
+ then begin
+ RESULT := aPicture.Bitmap.Canvas.Pixels[aPoint.X, aPoint.Y]
+ = aPicture.Bitmap.Canvas.Pixels[0, aPicture.Bitmap.Height-1];
+ end
+ else
+ if aPicture.Graphic is TIcon
+ then
+ RESULT := IconIsTransparentAtPos(aPicture.Icon, aPoint)
+end;
+
+// 9999 New function for CodeTyphon
+function IconIsTransparentAtPos(aIcon: TIcon; aPoint: TPoint): boolean;
+var aPic: TPicture;
+begin
+ RESULT := false;
+ aPic := TPicture.Create;
+
+ try
+ aPic.Bitmap.Width := aIcon.Width;
+ aPic.Bitmap.Height := aIcon.Height;
+ aPic.Bitmap.PixelFormat := pf1bit; // Black = not transparent
+ aPic.Bitmap.Canvas.Brush.Color := clWhite;
+ aPic.Bitmap.Canvas.FillRect(Rect(0, 0, aIcon.Width, aIcon.Height));
+
+ aPic.Assign(aIcon);
+
+ aPic.Bitmap.PixelFormat := pf1bit; // Black = not transparent
+
+ RESULT := aPic.Bitmap.Canvas.Pixels[aPoint.X, aPoint.Y] <> clBlack;
+
+ finally
+ aPic.Free;
+ end;
+end;
+
+function ValidGraphic(aGraphic: TGraphic): Boolean;
+begin
+ RESULT := false;
+ if aGraphic <> Nil
+ then
+ if not aGraphic.Empty
+ then RESULT := true;
+end;
+
+end.
+
diff --git a/components/industrialstuff/source/indcyTypes.pas b/components/industrialstuff/source/indcyTypes.pas
new file mode 100644
index 000000000..3f2883cf9
--- /dev/null
+++ b/components/industrialstuff/source/indcyTypes.pas
@@ -0,0 +1,86 @@
+{ Unit indcyTypes from cyTypes
+
+ Description:
+ Unit with Types declarations.
+
+ * ***** BEGIN LICENSE BLOCK *****
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with the
+ * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * The Initial Developer of the Original Code is Mauricio
+ * (https://sourceforge.net/projects/tcycomponents/).
+ *
+ * No contributors for now ...
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or the
+ * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
+ * case the provisions of the GPL or the LGPL are applicable instead of those
+ * above. If you wish to allow use of your version of this file only under the
+ * terms of either the GPL or the LGPL, and not to allow others to use your
+ * version of this file under the terms of the MPL, indicate your decision by
+ * deleting the provisions above and replace them with the notice and other
+ * provisions required by the LGPL or the GPL. If you do not delete the
+ * provisions above, a recipient may use your version of this file under the
+ * terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK *****}
+
+unit indcyTypes;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LCLIntf, LCLType, Graphics, Classes, types;
+
+type
+ // Graphic:
+ TCaptionRender = (crNormal, crPathEllipsis, crEndEllipsis, crWordEllipsis);
+ TCaptionOrientation = (coHorizontal, coHorizontalReversed, coVertical, coVerticalReversed);
+
+ TBgPosition = (bgCentered, bgTopLeft, bgTopCenter, bgTopRight, bgCenterRight, bgBottomRight, bgBottomCenter, bgBottomLeft, bgCenterLeft);
+ TBgStyle = (bgNone, bgNormal, bgMosaic, bgStretch, bgStretchProportional);
+
+ TcyBevelCut = (bcLowered, bcRaised, bcNone, bcTransparent);
+
+ TDgradOrientation = (dgdVertical, dgdHorizontal, dgdAngle, dgdRadial, dgdRectangle);
+ TDgradOrientationShape = (osRadial, osRectangle);
+ TDgradBalanceMode = (bmNormal, bmMirror, bmReverse, bmReverseFromColor, bmInvertReverse, bmInvertReverseFromColor);
+
+ // Cindy components:
+ TRunTimeDesignJob = (rjNothing, rjMove, rjResizeTop, rjResizeBottom, rjResizeLeft, rjResizeTopLeft,
+ rjResizeBottomLeft, rjResizeRight, rjResizeTopRight, rjResizeBottomRight);
+
+ TLineCoord = record
+ BottomCoord, TopCoord: TPoint;
+ end;
+
+//var
+// CaptionOrientationWarning: Boolean = true;
+
+const
+ DT_PATH_ELLIPSIS = $8000;
+ DT_WORD_ELLIPSIS = $8000;
+
+ cCaptionOrientationWarning = 'Note that text orientation doesn''t work with all fonts!';
+
+ Alignments: array[TAlignment] of Word = (DT_LEFT, DT_RIGHT, DT_CENTER);
+ WordWraps: array[Boolean] of Word = (DT_SINGLELINE, DT_WORDBREAK);
+ TextLayouts: array[TTextLayout] of Longint = (DT_TOP, DT_VCENTER, DT_BOTTOM);
+ CaptionOrientations: array[TCaptionOrientation] of word = (0, 1800, 900, 2700);
+ CaptionRenders: array[TCaptionRender] of Integer = (0, DT_PATH_ELLIPSIS, DT_END_ELLIPSIS, DT_WORD_ELLIPSIS);
+
+implementation
+
+
+end.
diff --git a/components/industrialstuff/source/indgnoumeter.pas b/components/industrialstuff/source/indgnoumeter.pas
new file mode 100644
index 000000000..9906c6ad9
--- /dev/null
+++ b/components/industrialstuff/source/indgnoumeter.pas
@@ -0,0 +1,457 @@
+{**********************************************************************
+ GnouMeter is a meter which can display an integer or a float value (Single).
+ Just like a progress bar or a gauge, all you have do do is to define
+ the Minimum and maximum values as well as the actual value.
+
+ Above the meter, one can display the name of the data being measured (optional)
+ and its actual value with its corresponding unit.
+ The minimum and maximum values are respectively shown at the bottom and the
+ top of the meter with their corresponding units.
+ The meter is filled with the color ColorFore and its background color
+ is defined by the ColorBack Property.
+
+ THIS COMPONENT IS ENTIRELY FREEWARE
+
+ Author: Jérôme Hersant
+ jhersant@post4.tele.dk
+***********************************************************************}
+
+unit indGnouMeter;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ Classes, Controls, Graphics, SysUtils, Messages, LMessages, Types, LCLType, LCLIntf;
+
+type
+ TindGnouMeter = class(TGraphicControl)
+ private
+ fValue: Double;
+ fColorFore: TColor;
+ fColorBack: TColor;
+ fSignalUnit: ShortString;
+ fValueMax: Double;
+ fValueMin: Double;
+ fDigits: Byte;
+ fIncrement: Double;
+ fShowIncrements: Boolean;
+ fGapTop: Word;
+ fGapBottom: Word;
+ fBarThickness: Word;
+ fMarkerColor: TColor;
+ fShowMarker: Boolean;
+ //Variables used internally
+ TopTextHeight: Word;
+ LeftMeter: Word;
+ DisplayValue: String;
+ DrawStyle: integer;
+ TheRect: TRect;
+ //End of variables used internally
+ procedure SetValue(val: Double);
+ procedure SetColorBack(val: TColor);
+ procedure SetColorFore(val: TColor);
+ procedure SetSignalUnit(val: ShortString);
+ procedure SetValueMin(val: Double);
+ procedure SetValueMax(val: Double);
+ procedure SetDigits(val: Byte);
+ procedure SetTransparent(val: Boolean);
+ function GetTransparent: Boolean;
+ procedure SetIncrement(val: Double);
+ procedure SetShowIncrements(val: Boolean);
+ procedure SetGapTop(val: Word);
+ procedure SetGapBottom(val: Word);
+ procedure SetBarThickness(val: Word);
+ procedure SetMarkerColor(val: TColor);
+ procedure SetShowMarker(val: Boolean);
+ procedure DrawTopText;
+ procedure DrawMeterBar;
+ procedure DrawIncrements;
+ function ValueToPixels(val: Double): integer;
+ procedure DrawValueMax;
+ procedure DrawValueMin;
+ procedure DrawMarker;
+ protected
+ procedure Paint; override;
+ procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property Align;
+ property Caption;
+ property Visible;
+ property ShowHint;
+ property Value: Double read fValue write SetValue;
+ property Color;
+ property Font;
+ property ParentColor;
+ property ColorFore: Tcolor read fColorFore write SetColorFore;
+ property ColorBack: Tcolor read fColorBack write SetColorBack;
+ property SignalUnit: ShortString read fSignalUnit write SetSignalUnit;
+ property ValueMin: Double read fValueMin write SetValueMin;
+ property ValueMax: Double read fValueMax write SetValueMax;
+ property Digits: Byte read fDigits write SetDigits;
+ property Increment: Double read fIncrement write SetIncrement;
+ property ShowIncrements: Boolean read fShowIncrements write SetShowIncrements;
+ property Transparent: Boolean read GetTransparent write SetTransparent;
+ property GapTop: Word read fGapTop write SetGapTop;
+ property GapBottom: Word read fGapBottom write SetGapBottom;
+ property BarThickness: Word read fBarThickness write SetBarThickness;
+ property MarkerColor: TColor read fMarkerColor write SetMarkerColor;
+ property ShowMarker: Boolean read fShowMarker write SetShowMarker;
+ end;
+
+
+implementation
+
+constructor TindGnouMeter.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ControlStyle := ControlStyle + [csReplicatable, csSetCaption];
+ Width := 100;
+ Height := 200;
+ fColorFore := clRed;
+ fColorBack := clBtnFace;
+ fMarkerColor := clBlue;
+ fValueMin := 0;
+ fValueMax := 100;
+ fIncrement := 10;
+ fShowIncrements := True;
+ fShowMarker := True;
+ fValue := 0;
+ fGapTop := 20;
+ fGapBottom := 10;
+ fBarThickness := 5;
+ fSignalUnit := 'Units';
+end;
+
+destructor TindGnouMeter.Destroy;
+begin
+ inherited Destroy;
+end;
+
+procedure TindGnouMeter.CMTextChanged(var Message: TMessage);
+begin
+ Invalidate;
+end;
+
+procedure TindGnouMeter.SetValue(val: Double);
+begin
+ if (val <> fValue) and (val >= fValueMin) and (val <= fValueMax) then
+ begin
+ fValue := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetColorFore(val: TColor);
+begin
+ if val <> fColorFore then
+ begin
+ fColorFore := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetColorBack(val: TColor);
+begin
+ if val <> fColorBack then
+ begin
+ fColorBack := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetSignalUnit(val: ShortString);
+begin
+ if val <> fSignalUnit then
+ begin
+ fSignalUnit := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetValueMin(val: Double);
+begin
+ if (val <> fValueMin) and (val <= fValue) then
+ begin
+ fValueMin := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetValueMax(val: Double);
+begin
+ if (val <> fValueMax) and (val >= fValue) then
+ begin
+ fValueMax := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetDigits(val: Byte);
+begin
+ if (val <> fDigits) then
+ begin
+ fDigits := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetIncrement(val: Double);
+begin
+ if (val <> fIncrement) and (val > 0) then
+ begin
+ fIncrement := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetShowIncrements(val: Boolean);
+begin
+ if (val <> fShowIncrements) then
+ begin
+ fShowIncrements := val;
+ Invalidate;
+ end;
+end;
+
+function TindGnouMeter.GetTransparent: Boolean;
+begin
+ Result := not (csOpaque in ControlStyle);
+end;
+
+procedure TindGnouMeter.SetTransparent(Val: Boolean);
+begin
+ if Val <> Transparent then
+ begin
+ if Val then
+ ControlStyle := ControlStyle - [csOpaque]
+ else
+ ControlStyle := ControlStyle + [csOpaque];
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetGapTop(val: Word);
+begin
+ if (val <> fGapTop) then
+ begin
+ fGapTop := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetGapBottom(val: Word);
+begin
+ if (val <> fGapBottom) then
+ begin
+ fGapBottom := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetBarThickness(val: Word);
+begin
+ if (val <> fBarThickness) and (val > 0) then
+ begin
+ fBarThickness := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetMarkerColor(val: TColor);
+begin
+ if (val <> fMarkerColor) then
+ begin
+ fMarkerColor := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.SetShowMarker(val: Boolean);
+begin
+ if (val <> fShowMarker) then
+ begin
+ fShowMarker := val;
+ Invalidate;
+ end;
+end;
+
+procedure TindGnouMeter.DrawIncrements;
+var
+ i: Double;
+ PosPixels: Word;
+begin
+ if fShowIncrements then
+ begin
+ with Canvas do
+ begin
+ i := fValueMin;
+ while i <= fValueMax do
+ begin
+ PosPixels := ValueToPixels(i);
+ pen.color := clGray;
+ MoveTo(LeftMeter + BarThickness + 3, PosPixels - 1);
+ LineTo(LeftMeter + BarThickness + 7, PosPixels - 1);
+ pen.color := clWhite;
+ MoveTo(LeftMeter + BarThickness + 3, PosPixels);
+ LineTo(LeftMeter + BarThickness + 7, PosPixels);
+ i := i + fIncrement;
+ end;
+ end;
+ end;
+end;
+
+procedure TindGnouMeter.DrawMarker;
+begin
+ if fShowMarker then
+ begin
+ with Canvas do
+ begin
+ pen.color := clWhite;
+ Brush.Style := bsClear;
+ MoveTo(LeftMeter - 2, ValueToPixels(fValue));
+ LineTo(LeftMeter - 6, ValueToPixels(fValue) - 4);
+ LineTo(LeftMeter - 6, ValueToPixels(fValue) + 4);
+ pen.color := clGray;
+ LineTo(LeftMeter - 2, ValueToPixels(fValue));
+
+ pen.color := fMarkerColor;
+ Brush.color := fMarkerColor;
+ Brush.Style := bsSolid;
+ Polygon([Point(LeftMeter - 3, ValueToPixels(fValue)),
+ Point(LeftMeter - 5, ValueToPixels(fValue) - 2),
+ Point(LeftMeter - 5, ValueToPixels(fValue) + 2),
+ Point(LeftMeter - 3, ValueToPixels(fValue))]);
+ end;
+ end;
+end;
+
+procedure TindGnouMeter.DrawTopText;
+begin
+ with Canvas do
+ begin
+ DisplayValue := Caption;
+ Brush.Style := bsClear;
+ TheRect := ClientRect;
+ DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_CENTER + DT_TOP;
+ Font.Style := [fsBold];
+ TopTextHeight := DrawText(Handle, PChar(DisplayValue),
+ Length(DisplayValue), TheRect, DrawStyle);
+
+ Font.Style := [];
+ TheRect.Top := TopTextHeight;
+ DisplayValue := FloatToStrF(Value, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
+ TopTextHeight := TopTextHeight + DrawText(Handle, PChar(DisplayValue),
+ Length(DisplayValue), TheRect, DrawStyle);
+ TopTextHeight := TopTextHeight + fGapTop;
+ end;
+end;
+
+procedure TindGnouMeter.DrawValueMin;
+begin
+ with Canvas do
+ begin
+ TheRect := ClientRect;
+ TheRect.Left := LeftMeter + BarThickness + 10;
+ TheRect.Top := TopTextHeight;
+ TheRect.Bottom := Height - fGapBottom + 6;
+ Brush.Style := bsClear;
+ DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_BOTTOM;
+ DisplayValue := FloatToStrF(ValueMin, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
+ DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
+ TheRect, DrawStyle);
+ end;
+end;
+
+procedure TindGnouMeter.DrawValueMax;
+begin
+ with Canvas do
+ begin
+ TheRect := ClientRect;
+ TheRect.Left := LeftMeter + BarThickness + 10;
+ TheRect.Top := TopTextHeight - 6;
+ Brush.Style := bsClear;
+ DrawStyle := DT_SINGLELINE + DT_NOPREFIX + DT_LEFT + DT_TOP;
+ DisplayValue := FloatToStrF(ValueMax, ffFixed, 8, fDigits) + ' ' + fSignalUnit;
+ DrawText(Handle, PChar(DisplayValue), Length(DisplayValue),
+ TheRect, DrawStyle);
+ end;
+end;
+
+procedure TindGnouMeter.DrawMeterBar;
+begin
+ with Canvas do
+ begin
+ pen.Color := fColorBack;
+ Brush.Color := fColorBack;
+ Brush.Style := bsSolid;
+ Rectangle(LeftMeter, ValueToPixels(fValueMax), LeftMeter +
+ fBarThickness, ValueToPixels(fValueMin));
+
+ pen.Color := fColorFore;
+ Brush.Color := fColorFore;
+ Brush.Style := bsSolid;
+ Rectangle(LeftMeter + 1, ValueToPixels(fValue), LeftMeter +
+ fBarThickness, ValueToPixels(fValueMin));
+
+ pen.color := clWhite;
+ Brush.Style := bsClear;
+ MoveTo(LeftMeter + fBarThickness - 1, ValueToPixels(fValueMax));
+ LineTo(LeftMeter, ValueToPixels(fValueMax));
+ LineTo(LeftMeter, ValueToPixels(fValueMin) - 1);
+
+ pen.color := clGray;
+ LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMin) - 1);
+ LineTo(LeftMeter + fBarThickness, ValueToPixels(fValueMax));
+
+ if (fValue > fValueMin) and (fValue < fValueMax) then
+ begin
+ pen.color := clWhite;
+ MoveTo(LeftMeter + 1, ValueToPixels(fValue));
+ LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue));
+ pen.color := clGray;
+ MoveTo(LeftMeter + 1, ValueToPixels(fValue) - 1);
+ LineTo(LeftMeter + fBarThickness, ValueToPixels(fValue) - 1);
+ end;
+
+ end;
+end;
+
+function TindGnouMeter.ValueToPixels(val: Double): integer;
+var
+ factor: Double;
+begin
+ Result := 0;
+ if fValueMax > fValueMin then
+ begin
+ Factor := (Height - fGapBottom - TopTextHeight) / (fValueMin - fValueMax);
+ Result := Round(Factor * val - Factor * fValueMax + TopTextHeight);
+ end;
+end;
+
+procedure TindGnouMeter.Paint;
+begin
+ LeftMeter := (Width div 2) - 10 - fBarThickness;
+ with Canvas do
+ begin
+ if not Transparent then
+ begin
+ Brush.Color := Self.Color;
+ Brush.Style := bsSolid;
+ FillRect(ClientRect);
+ end;
+ Brush.Style := bsClear;
+ DrawTopText;
+ DrawValueMin;
+ DrawValueMax;
+ DrawMeterBar;
+ DrawMarker;
+ DrawIncrements;
+ end;
+end;
+
+end.
diff --git a/components/industrialstuff/source/indled.pas b/components/industrialstuff/source/indled.pas
new file mode 100644
index 000000000..a5c497398
--- /dev/null
+++ b/components/industrialstuff/source/indled.pas
@@ -0,0 +1,371 @@
+{ Component(s):
+ TindLed ---> old cindy name tcyled
+
+ Description:
+ A simple led with Group feature
+ depending on the state: ON/OFF/DISABLE
+
+
+ * ***** BEGIN LICENSE BLOCK *****
+ *
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with the
+ * License. You may obtain a copy of the License at http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
+ * the specific language governing rights and limitations under the License.
+ *
+ * The Initial Developer of the Original Code is Mauricio
+ * (https://sourceforge.net/projects/tcycomponents/).
+ *
+ * No contributors for now ...
+ *
+ * Alternatively, the contents of this file may be used under the terms of
+ * either the GNU General Public License Version 2 or later (the "GPL"), or the
+ * GNU Lesser General Public License Version 2.1 or later (the "LGPL"), in which
+ * case the provisions of the GPL or the LGPL are applicable instead of those
+ * above. If you wish to allow use of your version of this file only under the
+ * terms of either the GPL or the LGPL, and not to allow others to use your
+ * version of this file under the terms of the MPL, indicate your decision by
+ * deleting the provisions above and replace them with the notice and other
+ * provisions required by the LGPL or the GPL. If you do not delete the
+ * provisions above, a recipient may use your version of this file under the
+ * terms of any one of the MPL, the GPL or the LGPL.
+ *
+ * ***** END LICENSE BLOCK *****
+
+Modified by Jurassic Pork 2013 for package Industrial of Lazarus}
+
+unit IndLed;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses Classes, Types, Controls, Graphics, indcyBaseLed, indcyTypes, indcyClasses, indcyGraphics;
+
+type
+ TShapeType = (stRectangle, stRoundRect, stEllipse);
+
+ TcyCustomLed = class(TcyBaseLed)
+ private
+ FLedColorOn: TColor;
+ FLedColorOff: TColor;
+ FLedColorDisabled: TColor;
+ FShapeRoundRectX: Integer;
+ FShapeRoundRectY: Integer;
+ FShapeLedColorOn: TColor;
+ FShapeLedColorOff: TColor;
+ FShapeLedColorDisabled: TColor;
+ FBevels: TcyBevels;
+ FShapeType: TShapeType;
+ FShapePenWidth: Word;
+ FTransparent: boolean;
+ procedure SetShapeLedColorOn(Value: TColor);
+ procedure SetShapePenWidth(Value: Word);
+ procedure SetShapeType(Value: TShapeType);
+ procedure SetShapeRoundRectX(Value: Integer);
+ procedure SetShapeRoundRectY(Value: Integer);
+ procedure SetBevels(const Value: TcyBevels);
+ procedure SetLedColorDisabled(Value: TColor);
+ procedure SetLedColorOff(Value: TColor);
+ procedure SetLedColorOn(Value: TColor);
+ procedure SetTransparent(const Value: boolean);
+ procedure SetShapeLedColorDisabled(const Value: TColor);
+ procedure SetShapeLedColorOff(const Value: TColor);
+ protected
+ procedure Paint; override;
+ function TransparentColorAtPos(Point: TPoint): boolean; override;
+ property Transparent: boolean read FTransparent write SetTransparent default false;
+ property LedColorOn: TColor read FLedColorOn write SetLedColorOn;
+ property LedColorOff: TColor read FLedColorOff write SetLedColorOff;
+ property LedColorDisabled: TColor read FLedColorDisabled write SetLedColorDisabled;
+ property ShapeLedColorOn: TColor read FShapeLedColorOn write SetShapeLedColorOn;
+ property ShapeLedColorOff: TColor read FShapeLedColorOff write SetShapeLedColorOff;
+ property ShapeLedColorDisabled: TColor read FShapeLedColorDisabled write SetShapeLedColorDisabled;
+ property ShapePenWidth: Word read FShapePenWidth write SetShapePenWidth default 1;
+ property ShapeType: TShapeType read FShapeType write SetShapeType default stRectangle;
+ property ShapeRoundRectX: Integer read FShapeRoundRectX write SetShapeRoundRectX default 10;
+ property ShapeRoundRectY: Integer read FShapeRoundRectY write SetShapeRoundRectY default 10;
+ property Bevels: TcyBevels read FBevels write SetBevels;
+ property Height default 25;
+ property Width default 25;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ end;
+
+ TindLed = class(TcyCustomLed)
+ private
+ protected
+ public
+ published
+ property Align;
+ property Anchors;
+ property Color;
+ property Constraints;
+ property Enabled;
+ property Visible;
+ property OnClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property ShowHint;
+ // Herited from TcyBaseLed :
+ property AllowAllOff;
+ property GroupIndex;
+ property LedValue;
+ property ReadOnly;
+ // Herited from TcyCustomLed :
+ property Bevels;
+ property LedColorOn;
+ property LedColorOff;
+ property LedColorDisabled;
+ property ShapeLedColorOn;
+ property ShapeLedColorOff;
+ property ShapeLedColorDisabled;
+ property ShapePenWidth;
+ property ShapeType;
+ property ShapeRoundRectX;
+ property ShapeRoundRectY;
+ property Transparent;
+ end;
+
+
+implementation
+
+constructor TcyCustomLed.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FBevels := TcyBevels.Create(self, TcyBevel);
+
+ // Determine at design time if
+ // the form is loading or if we have just added the component at design time :
+ if csDesigning in ComponentState
+ then
+ if Owner <> nil
+ then
+ if not (csLoading in Owner.ComponentState) // we have just added the component at design time
+ then begin
+ with FBevels.Add do // Frame
+ begin
+ HighlightColor := clBlack;
+ ShadowColor := clBlack;
+ end;
+
+ with FBevels.Add do // Inner 3D frame
+ Width := 3;
+
+ with FBevels.Add do // Contrast Frame
+ Style := bcLowered;
+
+ with FBevels.Add do // Border between Bevels and Shape
+ begin
+ HighlightColor := clBlack;
+ ShadowColor := clBlack;
+ Width := 1;
+ end;
+ end;
+
+ FTransparent := false;
+ FShapeType := stRectangle;
+ FShapePenWidth:= 1;
+ FShapeRoundRectX := 10;
+ FShapeRoundRectY := 10;
+ FShapeLedColorOn := clGreen;
+ FShapeLedColorOff := $00004000; // Dark green
+ FShapeLedColorDisabled := $00003468; // Dark maroon
+ FLedColorOn:= clLime;
+ FLedColorOff:= clGreen;
+ FLedColorDisabled:= $000059B3; // Maroon
+ Height := 25;
+ Width := 25;
+end;
+
+destructor TcyCustomLed.Destroy;
+begin
+ FBevels.Free;
+ FBevels := Nil;
+ inherited Destroy;
+end;
+
+procedure TcyCustomLed.Paint;
+var
+ Rect: TRect;
+begin
+ Rect := ClientRect;
+ // Draw background :
+ if not FTransparent
+ then begin
+ Canvas.Brush.Color := Color;
+ Canvas.FillRect(Rect);
+ end;
+
+ Bevels.DrawBevels(Canvas, Rect, false);
+
+ case ledStatus of
+ lsOn: Canvas.Brush.Color := FLedColorOn;
+ lsOff: Canvas.Brush.Color := FLedColorOff;
+ lsDisabled: Canvas.Brush.Color := FLedColorDisabled;
+ end;
+
+ if FShapePenWidth > 0
+ then begin
+ Rect := classes.Rect(Rect.Left + FShapePenWidth div 2,
+ Rect.Top + FShapePenWidth div 2,
+ Rect.Right - (FShapePenWidth-1) div 2,
+ Rect.Bottom - (FShapePenWidth-1) div 2);
+
+ case ledStatus of
+ lsOn: Canvas.Pen.Color := FShapeLedColorOn;
+ lsOff: Canvas.Pen.Color := FShapeLedColorOff;
+ lsDisabled: Canvas.Pen.Color := FShapeLedColorDisabled;
+ end;
+
+ Canvas.Pen.Width := FShapePenWidth;
+ end
+ else begin
+ Canvas.Pen.Color := Canvas.Brush.Color;
+ Canvas.Pen.Width := 1;
+ end;
+
+ case FShapeType of
+ stRectangle: canvas.Rectangle(Rect);
+ stRoundRect: canvas.RoundRect(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, ShapeRoundRectX, ShapeRoundRectY);
+ stEllipse : canvas.Ellipse(Rect);
+ end;
+end;
+
+function TcyCustomLed.TransparentColorAtPos(Point: TPoint): boolean;
+begin
+ RESULT := false;
+
+ if FTransparent and (Bevels.Count = 0) and (FShapeType = stEllipse)
+ then RESULT := not PointInEllipse(Point, ClientRect);
+end;
+
+procedure TcyCustomLed.SetTransparent(const Value: boolean);
+begin
+ if value <> FTransparent
+ then begin
+ FTransparent := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeLedColorOn(Value: TColor);
+begin
+ if value <> FShapeLedColorOn
+ then begin
+ FShapeLedColorOn := Value;
+
+ if GetLedStatus = lsOn
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeLedColorOff(const Value: TColor);
+begin
+ if value <> FShapeLedColorOff
+ then begin
+ FShapeLedColorOff := Value;
+
+ if GetLedStatus = lsOff
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeLedColorDisabled(const Value: TColor);
+begin
+ if value <> FShapeLedColorDisabled
+ then begin
+ FShapeLedColorDisabled := Value;
+
+ if GetLedStatus = lsDisabled
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapePenWidth(Value: Word);
+begin
+ if value <> FShapePenWidth
+ then begin
+ FShapePenWidth := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeRoundRectX(Value: Integer);
+begin
+ if Value <> FShapeRoundRectX
+ then begin
+ FShapeRoundRectX := value;
+
+ if FShapeType = stRoundRect
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeRoundRectY(Value: Integer);
+begin
+ if Value <> FShapeRoundRectY
+ then begin
+ FShapeRoundRectY := value;
+
+ if FShapeType = stRoundRect
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetShapeType(Value: TShapeType);
+begin
+ if value <> FShapeType
+ then begin
+ FShapeType := Value;
+ Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetLedColorOn(Value: TColor);
+begin
+ if value <> FLedColorOn
+ then begin
+ FLedColorOn := Value;
+
+ if GetLedStatus = lsOn
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetLedColorOff(Value: TColor);
+begin
+ if value <> FLedColorOff
+ then begin
+ FLedColorOff := Value;
+
+ if GetLedStatus = lsOff
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetLedColorDisabled(Value: TColor);
+begin
+ if value <> FLedColorDisabled
+ then begin
+ FLedColorDisabled := Value;
+
+ if GetLedStatus = lsDisabled
+ then Invalidate;
+ end;
+end;
+
+procedure TcyCustomLed.SetBevels(const Value: TcyBevels);
+begin
+ FBevels := Value;
+end;
+
+end.
diff --git a/components/industrialstuff/source/industrial_icons.res b/components/industrialstuff/source/industrial_icons.res
new file mode 100644
index 000000000..e95d08c64
Binary files /dev/null and b/components/industrialstuff/source/industrial_icons.res differ
diff --git a/components/industrialstuff/source/ledbuttons.res b/components/industrialstuff/source/ledbuttons.res
new file mode 100644
index 000000000..dfa1b714f
Binary files /dev/null and b/components/industrialstuff/source/ledbuttons.res differ
diff --git a/components/industrialstuff/source/lednumber.pas b/components/industrialstuff/source/lednumber.pas
new file mode 100644
index 000000000..ef748e418
--- /dev/null
+++ b/components/industrialstuff/source/lednumber.pas
@@ -0,0 +1,585 @@
+{*********************************************************}
+{* VPLEDLABEL.PAS 1.03 -> LEDNumber.PAS *}
+{*********************************************************}
+
+{* ***** BEGIN LICENSE BLOCK ***** *}
+{* Version: MPL 1.1 *}
+{* *}
+{* The contents of this file are subject to the Mozilla Public License *}
+{* Version 1.1 (the "License"); you may not use this file except in *}
+{* compliance with the License. You may obtain a copy of the License at *}
+{* http://www.mozilla.org/MPL/ *}
+{* *}
+{* Software distributed under the License is distributed on an "AS IS" basis, *}
+{* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License *}
+{* for the specific language governing rights and limitations under the *}
+{* License. *}
+{* *}
+{* The Original Code is TurboPower Visual PlanIt *}
+{* *}
+{* The Initial Developer of the Original Code is TurboPower Software *}
+{* *}
+{* Portions created by TurboPower Software Inc. are Copyright (C) 2002 *}
+{* TurboPower Software Inc. All Rights Reserved. *}
+{* *}
+{* Contributor(s): *}
+{* Modified by Jurassic Pork for include in industrial Stuff Lazarus package *}
+{* 05/2013 *}
+{* ***** END LICENSE BLOCK ***** *}
+
+unit LedNumber;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+ LMessages, Classes, Controls, Graphics;
+
+type
+ TSegmentSize = 2..10;
+ TLedNumberBorderStyle = (lnbNone, lnbSingle, lnbSunken, lnbRaised);
+
+ { TCustomLEDNumber }
+
+ TCustomLEDNumber = class(TGraphicControl)
+ private
+ FBorderStyle: TLedNumberBorderStyle;
+ FTransparent: boolean;
+ procedure SetBorderStyle(AValue: TLedNumberBorderStyle);
+ procedure SetTransparent(AValue: boolean);
+ protected{private}
+ FBgColor : TColor;
+ FOffColor : TColor;
+ FOnColor : TColor;
+ FColumns : Integer;
+ FRows : Integer;
+ FSize : TSegmentSize;
+ lbDrawBmp : TBitmap;
+ procedure CMTextChanged(var Message: TLMessage); message CM_TEXTCHANGED;
+ procedure Initialize(var Points: array of TPoint);
+ function NewOffset(xOry: char; OldOffset: Integer): Integer;
+ procedure ProcessCaption(Points: array of TPoint);
+ procedure PaintSegment(Segment: Integer; TheColor: TColor;
+ Points: array of TPoint; OffsetX, OffsetY: Integer);
+ procedure ResizeControl(Row, Col, Size: Integer);
+ function GetAbout: string;
+ procedure SetAbout(const Value: string);
+ procedure SetSize(Value: TSegmentSize);
+ procedure SetOnColor(Value: TColor);
+ procedure SetOffColor(Value: TColor);
+ procedure SetRows(Value: Integer);
+ procedure SetColumns(Value: Integer);
+ procedure SetbgColor(Value: TColor);
+ procedure SelectSegments(Segment: Word; Points: array of TPoint;
+ OffsetX, OffsetY: Integer);
+ protected
+ procedure Paint; override;
+ public
+ constructor Create(AOwner:TComponent);override;
+ destructor Destroy; override;
+ {properties}
+ property Version: string read GetAbout write SetAbout stored False;
+ property BorderStyle: TLedNumberBorderStyle read FBorderStyle write SetBorderStyle default lnbNone; {Draws border around segments.}
+ property Columns: Integer read FColumns write SetColumns default 10;
+ property Rows: Integer read FRows write SetRows default 1;
+ property BgColor: TColor read FbgColor write SetbgColor default clBlack;
+ property OffColor: TColor read FOffColor write SetOffColor default $000E3432;
+ property OnColor: TColor read FOnColor write SetOnColor default clLime;
+ property Size: TSegmentSize read FSize write SetSize default 2;
+ property Transparent: boolean read FTransparent write SetTransparent default false; {Draws segments with transparent background.BgColor is used as mask color.}
+ {Inherited properties}
+ property Caption;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property Visible;
+ end;
+
+ TLEDNumber = class(TCustomLEDNumber)
+ published
+ property Version;
+ property BorderStyle;
+ property Caption;
+ property Columns;
+ property Rows;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property BgColor;
+ property OffColor;
+ property OnColor;
+ property ParentShowHint;
+ property PopupMenu;
+ property Size;
+ property ShowHint;
+ property Transparent;
+ property Visible;
+ end;
+
+
+implementation
+
+
+// uses
+ // VpConst;
+
+{ LED Segment Map }
+{ }
+{ ------------------------ }
+{ | 1 | }
+{ ------------------------ }
+{ | | \ | | / | | }
+{ | | \ | | / | | }
+{ | | \ | | / | | }
+{ |2 |\3 \ |4 | /5 /|6 | }
+{ | | \ \| |/ / | | }
+{ | | \ | | / | | }
+{ ----------- ----------- }
+{ | 7 \/ 8 | }
+{ -----------/\----------- }
+{ | | / | | \ | | }
+{ | | / /| |\ \ | | }
+{ |9 |/10 / |11| \12 \|13| }
+{ | | / | | \ | | }
+{ | | / | | \ | | }
+{ | | / | | \ | | }
+{ ------------------------ |-----| }
+{ | 14 | | * | }
+{ ------------------------ |-----| }
+{ }
+{ * Period and comma are drawn here }
+{ Colon is drawn in the center of }
+{ segments 4 and 11 }
+
+{ Each segment is made up of 6 points. The segments that don't need 6 points, }
+{ such as the period and colon dots, return to the coordinates of the initial }
+{ point for the remaining unused points. }
+
+const
+{LED SEGMENT ARRAYS}
+ MAX_POINTS = 107;
+
+ DigitPoints: array[0..MAX_POINTS] of TPoint =
+ {Segment 1}
+ ((X:2;Y:2),(X:3;Y:1),(X:11;Y:1),(X:12;Y:2),(X:11;Y:3),(X:3;Y:3),
+ {Segment 2}
+ (X:2;Y:3),(X:3;Y:4),(X:3;Y:12),(X:2;Y:13),(X:1;Y:12),(X:1;Y:4),
+ {Segment 3}
+ (X:3;Y:3),(X:6;Y:9),(X:6;Y:13),(X:3;Y:7),(X:3;Y:3),(X:3;Y:3),
+ {Segment 4}
+ (X:7;Y:3),(X:8;Y:4),(X:8;Y:12),(X:7;Y:13),(X:6;Y:12),(X:6;Y:4),
+ {Segment 5}
+ (X:11;Y:3),(X:11;Y:7),(X:8;Y:13),(X:8;Y:9),(X:11;Y:3),(X:11;Y:3),
+ {Segment 6}
+ (X:12;Y:3),(X:13;Y:4),(X:13;Y:12),(X:12;Y:13),(X:11;Y:12),(X:11;Y:4),
+ {Segment 7}
+ (X:2;Y:14),(X:3;Y:13),(X:6;Y:13),(X:7;Y:14),(X:6;Y:15),(X:3;Y:15),
+ {Segment 8}
+ (X:7;Y:14),(X:8;Y:13),(X:11;Y:13),(X:12;Y:14),(X:11;Y:15),(X:8;Y:15),
+ {Segment 9}
+ (X:2;Y:15),(X:3;Y:16),(X:3;Y:24),(X:2;Y:25),(X:1;Y:24),(X:1;Y:16),
+ {Segment 10}
+ (X:6;Y:15),(X:6;Y:19),(X:3;Y:25),(X:3;Y:21),(X:6;Y:15),(X:6;Y:15),
+ {Segment 11}
+ (X:7;Y:15),(X:8;Y:16),(X:8;Y:24),(X:7;Y:25),(X:6;Y:24),(X:6;Y:16),
+ {Segment 12}
+ (X:8;Y:15),(X:11;Y:21),(X:11;Y:25),(X:8;Y:19),(X:8;Y:15),(X:8;Y:15),
+ {Segment 13}
+ (X:12;Y:15),(X:13;Y:16),(X:13;Y:24),(X:12;Y:25),(X:11;Y:24),(X:11;Y:16),
+ {Segment 14}
+ (X:2;Y:26),(X:3;Y:25),(X:11;Y:25),(X:12;Y:26),(X:11;Y:27),(X:3;Y:27),
+ {Period }
+ (X:14;Y:25),(X:16;Y:25),(X:16;Y:27),(X:14;Y:27),(X:14;Y:25),(X:14;Y:25),
+ {Comma }
+ (X:14;Y:25),(X:16;Y:25),(X:16;Y:27),(X:13;Y:30),(X:14;Y:27),(X:14;Y:25),
+ {Colon Top }
+ (X:5;Y:7),(X:9;Y:7),(X:9;Y:10),(X:5;Y:10),(X:5;Y:7),(X:5;Y:7),
+ {Colon Btm }
+ (X:5;Y:20),(X:9;Y:20),(X:9;Y:23),(X:5;Y:23),(X:5;Y:20),(X:5;Y:20));
+
+ Characters: Array[0..72] of Word =
+ ($0000,$3B70,$1320,$0001,$0300,$0002,$0840,$CCCC,$1020,$8784,
+ { ' ' * + , - . / 0 1 2 }
+ $870C,$4708,$C30C,$C38C,$8408,$C78C,$C70C,$0810,$2040,$C788,
+ { 3 4 5 6 7 8 9 < > A }
+ $952C,$C084,$942C,$C384,$C380,$C18C,$4788,$9024,$048C,$4A90,
+ { B C D E F G H I J K }
+ $4084,$6C88,$6498,$C48C,$C780,$C49E,$C790,$C214,$9020,$448C,
+ { L M N O P Q R S T U }
+ $48C0,$44D8,$2850,$2820,$8844,$2010,$C788,$952C,$C084,$942C,
+ { V W X Y Z / a b c d }
+ $C384,$C380,$C18C,$4788,$9024,$048C,$4A90,$4084,$6C88,$6498,
+ { e f g h i j k l m n }
+ $C48C,$C780,$C49E,$C790,$C214,$9020,$448C,$48C0,$44D8,$2850,
+ { o p q r s t u v w x }
+ $2820,$8844,$FFFF);
+ { y z : }
+
+ CharacterNDX: Array[1..122] of integer =
+ (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2, 3, 4, 5, 6, 7, 8, 9,
+ 10, 11, 12, 13, 14, 15, 16, 72, 0, 17, 0, 18, 0, 0, 19, 20, 21, 22, 23, 24,
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43,
+ 44, 0, 45, 0, 0, 0, 0, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
+ 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44);
+
+
+{===== TCustomLEDNumber ============================================}
+
+constructor TCustomLEDNumber.Create(AOwner:TComponent);
+begin
+ inherited Create(AOwner);
+ FTransparent := False;
+ FBorderStyle := lnbNone;
+ ControlStyle := [csCaptureMouse,
+ csOpaque,
+ csSetCaption,
+ csClickEvents,
+ csDoubleClicks];
+ Width := 170;
+ Height := 30;
+ FOnColor := clLime;
+ FOffColor := $000E3432;
+ FBgColor := clBlack;
+ FSize := 2;
+ FRows := 1;
+ FColumns := 10;
+ Caption := 'LED-LABEL';
+ lbDrawBmp := TBitmap.Create;
+end;
+{=====}
+
+destructor TCustomLEDNumber.Destroy;
+begin
+ lbDrawBmp.Free;
+ lbDrawBmp := nil;
+ inherited Destroy;
+end;
+{=====}
+
+function TCustomLEDNumber.GetAbout : string;
+begin
+ Result := ''; //VpVersionStr;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetAbout(const Value : string);
+begin
+ {Leave empty}
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetTransparent(AValue: boolean);
+begin
+ if FTransparent=AValue then Exit;
+ FTransparent:=AValue;
+ lbDrawBmp.Transparent := FTransparent;
+ lbDrawBmp.TransparentColor := FBgColor;
+ Invalidate;
+end;
+
+procedure TCustomLEDNumber.SetBorderStyle(AValue: TLedNumberBorderStyle);
+begin
+ if FBorderStyle=AValue then Exit;
+ FBorderStyle:=AValue;
+ Invalidate;
+end;
+
+procedure TCustomLEDNumber.CMTextChanged(var Message: TLMessage);
+begin
+ inherited;
+ Invalidate;
+end;
+{=====}
+
+procedure TCustomLEDNumber.Initialize(var Points: array of TPoint);
+var
+ I : Integer;
+begin
+ for I := 0 to MAX_POINTS do begin
+ Points[i].X := DigitPoints[i].X * (FSize - 1);
+ Points[i].Y := DigitPoints[i].Y * (FSize - 1);
+ end;
+end;
+{=====}
+
+function TCustomLEDNumber.NewOffset(xOry: char; OldOffset: Integer): Integer;
+begin
+ if (xOry = 'x')then
+ newOffset := oldOffset + 17 * (FSize - 1)
+ else
+ newOffset := oldOffset + 30 * (FSize -1)
+end;
+{=====}
+
+procedure TCustomLEDNumber.Paint;
+var
+ Points: array[0..MAX_POINTS] of TPoint;
+ ARect: TRect;
+begin
+ lbDrawBMP.Width := Width;
+ lbDrawBMP.Height := Height;
+
+ Initialize(Points);
+ lbDrawBMP.Canvas.Brush.Color := FBgColor;
+ lbDrawBMP.Canvas.FillRect(ClientRect);
+ ProcessCaption(Points);
+
+ Canvas.CopyMode := cmSrcCopy;
+ if BorderStyle <> lnbNone then
+ begin
+ ARect := ClientRect;
+ case BorderStyle of
+ lnbSingle:
+ begin
+ Canvas.Pen.Color := cl3DDkShadow;
+ Canvas.Frame(ARect);
+ end;
+ lnbSunken: Canvas.Frame3D(ARect, cl3DDkShadow, clBtnHiLight, 1);
+ lnbRaised: Canvas.Frame3D(ARect, clBtnHiLight, cl3DDkShadow, 1);
+ end;
+ inc(ARect.Left, 1);
+ inc(ARect.Top, 1);
+ inc(ARect.Right, 1);
+ inc(ARect.Bottom, 1);
+ Canvas.StretchDraw(ARect, lbDrawBMP);
+ end else
+ Canvas.Draw(0, 0, lbDrawBMP);
+end;
+{=====}
+
+procedure TCustomLEDNumber.PaintSegment(Segment: Integer; TheColor: TColor;
+ Points: array of TPoint; OffsetX, OffsetY: Integer);
+var
+ I: Integer;
+ DrawPts: array[0..5] of TPoint;
+begin
+ Dec(Segment);
+ lbDrawBMP.Canvas.Pen.Style := psClear;
+ lbDrawBMP.Canvas.Brush.Color := TheColor;
+ for i := 0 to 5 do begin
+ DrawPts[i].X := offsetX + Points[Segment * 6 + i].X;
+ DrawPts[i].Y := offsetY + Points[Segment * 6 + i].Y;
+ end;
+ lbDrawBMP.Canvas.Polygon(DrawPts);
+end;
+{=====}
+
+procedure TCustomLEDNumber.SelectSegments(Segment: Word;
+ Points: array of TPoint; OffsetX, OffsetY: Integer);
+var
+ I : integer;
+ Bit : word;
+ MyColor : TColor;
+ Skip : Boolean;
+begin
+ if (Segment and $FFFF) = $FFFF then begin
+ MyColor := FOnColor;
+ PaintSegment(17, MyColor, Points, OffsetX, OffsetY);
+ PaintSegment(18, MyColor, Points, OffsetX, OffsetY);
+ end
+ else begin
+ Bit := $8000;
+ for I := 1 to 16 do begin
+ Skip := False;
+ if (Segment and Bit) = Bit then
+ MyColor := FOnColor
+ else begin
+ if (i = 15) or (i = 16) then
+ Skip := True;
+ MyColor := FOffColor;
+ end;
+ if (not Skip) and (MyColor <> FBgColor) then
+ PaintSegment(I, MyColor, Points, OffsetX, OffsetY);
+ Bit := Bit div 2;
+ end;
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.ProcessCaption(Points: array of TPoint);
+var
+ Next : Char;
+ Last : Char;
+ I, X : Integer;
+ Row, ColsPerRow: Integer;
+ Tmp : Integer;
+ OffsetX : Integer;
+ OffsetY : Integer;
+ DisplayStr : string;
+begin
+ Last := #0;
+ OffsetX := FSize;
+ OffsetY := 0;
+
+ DisplayStr := Caption;
+
+ if Length(DisplayStr) > 0 then
+ if (DisplayStr[1] = ',') or (DisplayStr[1] = '.') then
+ DisplayStr := ' ' + DisplayStr;
+
+ Row := 1;
+ ColsPerRow := 0;
+ for I := 1 to Length(Caption) do begin
+ Next := Caption[I];
+ case Ord(Next) of
+ 42..58,60,62,65..90,92,97..122: begin
+ if ColsPerRow = FColumns then begin
+ Row := Row + 1;
+ if Row > FRows then
+ exit;
+ offsetY := newOffset('y',offsetY);
+ offsetX := FSize;
+ ColsPerRow := 0
+ end;
+ if (Next = '.') or (Next = ',') then
+ if (Last = '.') or (Last = ',') then begin
+ SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points,
+ OffsetX, OffsetY);
+ OffsetX := NewOffset('x', OffsetX);
+ end
+ else begin
+ OffsetX := OffsetX - (17 * (FSize - 1));
+ Tmp := (Characters[CharacterNDX[Ord(Next)]]
+ or Characters[CharacterNDX[Ord(Last)]]);
+ SelectSegments(Tmp, Points, OffsetX, OffsetY);
+ OffsetX := NewOffset('x', OffsetX);
+ end
+ else begin
+ SelectSegments(Characters[CharacterNDX[Ord(Next)]], Points, OffsetX,
+ OffsetY);
+ offsetX := NewOffset('x', OffsetX);
+ ColsPerRow := ColsPerRow + 1;
+ end;
+ end;
+ 10: begin {eat linefeed}
+ end;
+ 13: begin
+ if ColsPerRow < FColumns then
+ for x := 1 to (FColumns - ColsPerRow) do begin
+ SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
+ OffsetX := NewOffset('x', OffsetX);
+ end;
+ Row := Row + 1;
+ if Row > FRows then
+ exit;
+ OffsetY := NewOffset('y', OffsetY);
+ OffsetX := FSize;
+ ColsPerRow := 0;
+ end;
+ else begin
+ if ColsPerRow = FColumns then begin
+ Row := Row + 1;
+ if Row > FRows then
+ Exit;
+ OffsetY := NewOffset('y', OffsetY);
+ OffsetX := FSize;
+ ColsPerRow := 0;
+ end;
+ SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
+ OffsetX := newOffset('x', OffsetX);
+ ColsPerRow := ColsPerRow + 1;
+ end;
+ end;
+ Last := Next;
+ end;
+ for x := 1 to (FColumns - ColsPerRow) do begin
+ SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
+ OffsetX := NewOffset('x', OffsetX);
+ end;
+ if (FColumns * FRows) > Length(caption) then begin
+ for X := Row + 1 to FRows do begin
+ OffsetX := FSize;
+ OffsetY := NewOffset('y', OffsetY);
+ for I := 1 to FColumns do begin
+ SelectSegments(Characters[CharacterNDX[1]], Points, OffsetX, OffsetY);
+ OffsetX := NewOffset('x', OffsetX);
+ end;
+ end;
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.ResizeControl(Row, Col, Size: Integer);
+begin
+ FRows := Row;
+ FColumns := Col;
+ FSize := Size;
+ SetBounds(Left, Top, FColumns * 17 * (FSize - 1), FRows * 30 * (FSize - 1));
+ Invalidate;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetbgColor(Value: TColor);
+begin
+ if FBgColor <> Value then begin
+ FBgColor := Value;
+ Invalidate;
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetOnColor(Value:TColor);
+begin
+ if FOnColor <> Value then begin
+ FOnColor := Value;
+ Invalidate;
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetOffColor(Value:TColor);
+begin
+ if FOffColor <> Value then begin
+ FOffColor := Value;
+ Invalidate;
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetRows(Value : Integer);
+begin
+ if FRows <> Value then begin
+ if Value < 1 then
+ Value := 1;
+ ResizeControl(Value, FColumns, FSize);
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetColumns(Value : Integer);
+begin
+ if FColumns <> Value then begin
+ if Value < 1 then
+ Value := 1;
+ ResizeControl(FRows, Value, FSize);
+ end;
+end;
+{=====}
+
+procedure TCustomLEDNumber.SetSize(Value : TSegmentSize);
+begin
+ if FSize <> Value then begin
+ //if Value < 2 then <- unreachable
+ // Value := 2;
+ //if Value > 10 then
+ // Value := 10;
+ ResizeControl(FRows, FColumns, Value);
+ end;
+end;
+{=====}
+end.
diff --git a/components/industrialstuff/source/sensors.pas b/components/industrialstuff/source/sensors.pas
new file mode 100644
index 000000000..a4fb4e27b
--- /dev/null
+++ b/components/industrialstuff/source/sensors.pas
@@ -0,0 +1,485 @@
+{ 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 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 < FValueRed) 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.
diff --git a/components/industrialstuff/source/sensors.res b/components/industrialstuff/source/sensors.res
new file mode 100644
index 000000000..744828bea
Binary files /dev/null and b/components/industrialstuff/source/sensors.res differ