pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

IndustrialStuff: Fix functionality of Flash method of TAdvLED in case of too frequent calls.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8209 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-03-16 09:45:38 +00:00
parent 30044a8cf3
commit 31a6f90915
3 changed files with 19 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi
View File

@ -44,6 +44,7 @@
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>

5
components/industrialstuff/Example/AdvLED/main.pas
View File

@ -35,6 +35,11 @@ implementation
procedure TForm1.Button1Click(Sender: TObject);
begin
case AdvLed1.State of
lsOFF: AdvLed1.FlashMode := fmFlashOffToOn;
lsON: AdvLed1.FlashMode := fmFlashOnToOff;
else exit;
end;
AdvLed1.Flash(100);
end;

15
components/industrialstuff/source/AdvLed.pas
View File

@ -30,6 +30,7 @@ type
TLedState = (lsDisabled, lsOff, lsOn);
TAdvLedGlyphs = array[TLedState] of TLedBitmap;
TLedStateEvent = procedure(Sender: TObject; AState: TLedState) of object;
TFlashMode = (fmFlashOffToOn, fmFlashOnToOff);
// led control that shows the state of serial signals
TAdvLed = class(TCustomImage)
@ -41,6 +42,7 @@ type
FGlyphs: TAdvLedGlyphs;
FBlinkTimer: TTimer;
FFlashTimer: TTimer;
FFlashMode: TFlashMode;
function GetGlyph(const Index: Integer): TLedBitmap;
function GetBlinkDuration: Integer;
procedure SetKind(const Value: TLedKind);
@ -80,6 +82,7 @@ type
property State: TLedState read FState write SetState;
property Blink: Boolean read FBlink write SetBlink;
property BlinkDuration: Integer read GetBlinkDuration write SetBlinkDuration default 1000;
property FlashMode: TFlashMode read FFlashMode write FFlashMode default fmFlashOffToOn;
property Align;
property AutoSize default true;
property Center;
@ -217,12 +220,20 @@ end;
procedure TAdvLed.DoFlashTimer(Sender: TObject);
begin
FFlashTimer.Enabled:= False;
Toggle;
case FFlashMode of
fmFlashOffToOn: SetState(lsOff);
fmFlashOnToOff: SetState(lsOn);
end;
end;
procedure TAdvLed.Flash(ADuration: integer);
begin
Toggle;
if FState = lsDisabled then
exit;
case FFlashMode of
fmFlashOffToOn: SetState(lsOn);
fmFlashOnToOff: SetState(lsOff);
end;
FFlashTimer.Interval := ADuration;
FFlashTimer.Enabled := true;
end;