Move Industrial package from Lazarus sources to CCR.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@5565 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
juhamanninen
parent
26d73deff8
commit
560a1e5ba2
Binary file not shown.
|
After Width: | Height: | Size: 4.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 4.3 KiB |
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
105
components/industrialstuff/Example/Ex_IndustrialStuff.lpi
Normal file
105
components/industrialstuff/Example/Ex_IndustrialStuff.lpi
Normal file
@ -0,0 +1,105 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<PathDelim Value="\"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Ex_IndustrialStuff"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<i18n>
|
||||
<EnableI18N LFM="False"/>
|
||||
</i18n>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="industrial"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="Ex_IndustrialStuff.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<UnitName Value="Ex_IndustrialStuff"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="u_industrial.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="u_industrial"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<Target>
|
||||
<Filename Value="Ex_IndustrialStuff"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<Checks>
|
||||
<IOChecks Value="True"/>
|
||||
<RangeChecks Value="True"/>
|
||||
<OverflowChecks Value="True"/>
|
||||
<StackChecks Value="True"/>
|
||||
</Checks>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="2"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<LinkSmart Value="True"/>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
components/industrialstuff/Example/Ex_IndustrialStuff.lpr
Normal file
21
components/industrialstuff/Example/Ex_IndustrialStuff.lpr
Normal file
@ -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.
|
||||
|
||||
BIN
components/industrialstuff/Example/Ex_IndustrialStuff.res
Normal file
BIN
components/industrialstuff/Example/Ex_IndustrialStuff.res
Normal file
Binary file not shown.
134
components/industrialstuff/Example/u_industrial.lfm
Normal file
134
components/industrialstuff/Example/u_industrial.lfm
Normal file
@ -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
|
||||
39
components/industrialstuff/Example/u_industrial.pas
Normal file
39
components/industrialstuff/Example/u_industrial.pas
Normal file
@ -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.
|
||||
|
||||
95
components/industrialstuff/industrial.lpk
Normal file
95
components/industrialstuff/industrial.lpk
Normal file
@ -0,0 +1,95 @@
|
||||
<?xml version="1.0"?>
|
||||
<CONFIG>
|
||||
<Package Version="4">
|
||||
<PathDelim Value="\"/>
|
||||
<Name Value="industrial"/>
|
||||
<Author Value="Jurassic Pork"/>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<PathDelim Value="\"/>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="source"/>
|
||||
<OtherUnitFiles Value="source"/>
|
||||
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<CodeGeneration>
|
||||
<SmartLinkUnit Value="True"/>
|
||||
<Optimizations>
|
||||
<OptimizationLevel Value="2"/>
|
||||
</Optimizations>
|
||||
</CodeGeneration>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<GenerateDebugInfo Value="False"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
<Other>
|
||||
<CompilerMessages>
|
||||
<MsgFileName Value=""/>
|
||||
</CompilerMessages>
|
||||
<CompilerPath Value="$(CompPath)"/>
|
||||
</Other>
|
||||
</CompilerOptions>
|
||||
<Description Value="Industrial-themed (IPV/PCV) components and gauges (e.g. LEDs)."/>
|
||||
<License Value="MPL + GPL "/>
|
||||
<Version Minor="1"/>
|
||||
<Files Count="10">
|
||||
<Item1>
|
||||
<Filename Value="source\indled.pas"/>
|
||||
<UnitName Value="IndLed"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Filename Value="source\sensors.pas"/>
|
||||
<UnitName Value="Sensors"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Filename Value="source\AllIndustrialRegister.pas"/>
|
||||
<HasRegisterProc Value="True"/>
|
||||
<UnitName Value="AllIndustrialRegister"/>
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Filename Value="source\lednumber.pas"/>
|
||||
<UnitName Value="LedNumber"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Filename Value="source\indgnoumeter.pas"/>
|
||||
<UnitName Value="IndGnouMeter"/>
|
||||
</Item5>
|
||||
<Item6>
|
||||
<Filename Value="source\AdvLed.pas"/>
|
||||
<UnitName Value="AdvLed"/>
|
||||
</Item6>
|
||||
<Item7>
|
||||
<Filename Value="source\indcyBaseLed.pas"/>
|
||||
<UnitName Value="indcyBaseLed"/>
|
||||
</Item7>
|
||||
<Item8>
|
||||
<Filename Value="source\indcyClasses.pas"/>
|
||||
<UnitName Value="indcyClasses"/>
|
||||
</Item8>
|
||||
<Item9>
|
||||
<Filename Value="source\indcyGraphics.pas"/>
|
||||
<UnitName Value="indcyGraphics"/>
|
||||
</Item9>
|
||||
<Item10>
|
||||
<Filename Value="source\indcyTypes.pas"/>
|
||||
<UnitName Value="indcyTypes"/>
|
||||
</Item10>
|
||||
</Files>
|
||||
<Type Value="RunAndDesignTime"/>
|
||||
<RequiredPkgs Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="IDEIntf"/>
|
||||
</Item1>
|
||||
</RequiredPkgs>
|
||||
<UsageOptions>
|
||||
<UnitPath Value="$(PkgOutDir)"/>
|
||||
</UsageOptions>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<CustomOptions Items="ExternHelp" Version="2">
|
||||
<_ExternHelp Items="Count"/>
|
||||
</CustomOptions>
|
||||
</Package>
|
||||
</CONFIG>
|
||||
23
components/industrialstuff/industrial.pas
Normal file
23
components/industrialstuff/industrial.pas
Normal file
@ -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.
|
||||
BIN
components/industrialstuff/resources/black.png
Normal file
BIN
components/industrialstuff/resources/black.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 775 B |
3
components/industrialstuff/resources/build.bat
Normal file
3
components/industrialstuff/resources/build.bat
Normal file
@ -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
|
||||
34
components/industrialstuff/resources/bulboff.xpm
Normal file
34
components/industrialstuff/resources/bulboff.xpm
Normal file
@ -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",
|
||||
"@@@@@@@@@@@@@@@",
|
||||
"@@@@@@@@@@@@@@@",
|
||||
"@@@@@@@@@@@@@@@",
|
||||
"@@@@@@@@@@@@@@@",
|
||||
"@@@@@@ @@@@@@",
|
||||
"@@@@@ ))) @@@@@",
|
||||
"@@@@ ))))) @@@@",
|
||||
"@@@@ ))&)) @@@@",
|
||||
"@@@@ ))&)) @@@@",
|
||||
"@@@@@ )&) @@@@@",
|
||||
"@@@@@@ ) @@@@@@",
|
||||
"@@@@@@ ) @@@@@@",
|
||||
"@@@@@@ @@@@@@",
|
||||
"@@@@@@ * @@@@@@",
|
||||
"@@@@@@ @@@@@@"};
|
||||
34
components/industrialstuff/resources/bulbon.xpm
Normal file
34
components/industrialstuff/resources/bulbon.xpm
Normal file
@ -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",
|
||||
"@@@@@@@;@@@@@@@",
|
||||
"@@@@@@@;@@@@@@@",
|
||||
"@@;@@;;;;;@@;@@",
|
||||
"@@@;;;;;;;;;@@@",
|
||||
"@@@;;; ;;;@@@",
|
||||
"@@;;; );) ;;;@@",
|
||||
"@@;; ););) ;;@@",
|
||||
";;;; ;)&); ;;;;",
|
||||
"@@;; );&;) ;;@@",
|
||||
"@@;;; )&) ;;;@@",
|
||||
"@@@;;; ) ;;;@@@",
|
||||
"@@@;;; ; ;;;@@@",
|
||||
"@@;@@; ;@@;@@",
|
||||
"@@@@@@ * @@@@@@",
|
||||
"@@@@@@ @@@@@@"};
|
||||
BIN
components/industrialstuff/resources/green.png
Normal file
BIN
components/industrialstuff/resources/green.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
@ -0,0 +1,6 @@
|
||||
tadvled.png
|
||||
tanalogsensor.png
|
||||
tindgnoumeter.png
|
||||
tindled.png
|
||||
tlednumber.png
|
||||
tstoplightsensor.png
|
||||
6
components/industrialstuff/resources/ledbuttons.txt
Normal file
6
components/industrialstuff/resources/ledbuttons.txt
Normal file
@ -0,0 +1,6 @@
|
||||
black.png
|
||||
green.png
|
||||
red.png
|
||||
yellow.png
|
||||
bulboff.xpm
|
||||
bulbon.xpm
|
||||
BIN
components/industrialstuff/resources/red.png
Normal file
BIN
components/industrialstuff/resources/red.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.8 KiB |
4
components/industrialstuff/resources/sensors.txt
Normal file
4
components/industrialstuff/resources/sensors.txt
Normal file
@ -0,0 +1,4 @@
|
||||
stop_green.png
|
||||
stop_red.png
|
||||
stop_unknown.png
|
||||
stop_yellow.png
|
||||
BIN
components/industrialstuff/resources/stop_green.png
Normal file
BIN
components/industrialstuff/resources/stop_green.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 235 B |
BIN
components/industrialstuff/resources/stop_red.png
Normal file
BIN
components/industrialstuff/resources/stop_red.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 239 B |
BIN
components/industrialstuff/resources/stop_unknown.png
Normal file
BIN
components/industrialstuff/resources/stop_unknown.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 244 B |
BIN
components/industrialstuff/resources/stop_yellow.png
Normal file
BIN
components/industrialstuff/resources/stop_yellow.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 235 B |
BIN
components/industrialstuff/resources/tadvled.png
Normal file
BIN
components/industrialstuff/resources/tadvled.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.7 KiB |
BIN
components/industrialstuff/resources/tanalogsensor.png
Normal file
BIN
components/industrialstuff/resources/tanalogsensor.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 193 B |
BIN
components/industrialstuff/resources/tindadvled.png
Normal file
BIN
components/industrialstuff/resources/tindadvled.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 787 B |
BIN
components/industrialstuff/resources/tindgnoumeter.png
Normal file
BIN
components/industrialstuff/resources/tindgnoumeter.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 363 B |
BIN
components/industrialstuff/resources/tindled.png
Normal file
BIN
components/industrialstuff/resources/tindled.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 313 B |
BIN
components/industrialstuff/resources/tlednumber.png
Normal file
BIN
components/industrialstuff/resources/tlednumber.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 219 B |
BIN
components/industrialstuff/resources/tstoplightsensor.png
Normal file
BIN
components/industrialstuff/resources/tstoplightsensor.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 258 B |
BIN
components/industrialstuff/resources/yellow.png
Normal file
BIN
components/industrialstuff/resources/yellow.png
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 1.8 KiB |
330
components/industrialstuff/source/AdvLed.pas
Normal file
330
components/industrialstuff/source/AdvLed.pas
Normal file
@ -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.
|
||||
30
components/industrialstuff/source/AllIndustrialRegister.pas
Normal file
30
components/industrialstuff/source/AllIndustrialRegister.pas
Normal file
@ -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.
|
||||
228
components/industrialstuff/source/indcyBaseLed.pas
Normal file
228
components/industrialstuff/source/indcyBaseLed.pas
Normal file
@ -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.
|
||||
307
components/industrialstuff/source/indcyClasses.pas
Normal file
307
components/industrialstuff/source/indcyClasses.pas
Normal file
@ -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.
|
||||
198
components/industrialstuff/source/indcyGraphics.pas
Normal file
198
components/industrialstuff/source/indcyGraphics.pas
Normal file
@ -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.
|
||||
|
||||
86
components/industrialstuff/source/indcyTypes.pas
Normal file
86
components/industrialstuff/source/indcyTypes.pas
Normal file
@ -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.
|
||||
457
components/industrialstuff/source/indgnoumeter.pas
Normal file
457
components/industrialstuff/source/indgnoumeter.pas
Normal file
@ -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.
|
||||
371
components/industrialstuff/source/indled.pas
Normal file
371
components/industrialstuff/source/indled.pas
Normal file
@ -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.
|
||||
BIN
components/industrialstuff/source/industrial_icons.res
Normal file
BIN
components/industrialstuff/source/industrial_icons.res
Normal file
Binary file not shown.
BIN
components/industrialstuff/source/ledbuttons.res
Normal file
BIN
components/industrialstuff/source/ledbuttons.res
Normal file
Binary file not shown.
585
components/industrialstuff/source/lednumber.pas
Normal file
585
components/industrialstuff/source/lednumber.pas
Normal file
@ -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.
|
||||
485
components/industrialstuff/source/sensors.pas
Normal file
485
components/industrialstuff/source/sensors.pas
Normal file
@ -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.
|
||||
BIN
components/industrialstuff/source/sensors.res
Normal file
BIN
components/industrialstuff/source/sensors.res
Normal file
Binary file not shown.
Loading…
Reference in New Issue
Block a user