IndustrialStuff: Add Flash method to TAdvLed (GitLab issue #39021). Modified patch by Boban Spasic). Add demo.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8198 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi

@@ -0,0 +1,86 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="12"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <CompatibilityMode Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <Title Value="AdvLED_Demo"/>
+      <Scaled Value="True"/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <XPManifest>
+        <DpiAware Value="True"/>
+      </XPManifest>
+      <Icon Value="0"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="Default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <UseFileFilters Value="True"/>
+    </PublishOptions>
+    <RunParams>
+      <FormatVersion Value="2"/>
+    </RunParams>
+    <RequiredPackages Count="2">
+      <Item1>
+        <PackageName Value="industrial"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="LCL"/>
+      </Item2>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="AdvLED_Demo.lpr"/>
+        <IsPartOfProject Value="True"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="main.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="Form1"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="Main"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="AdvLED_Demo"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+      <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpr

@@ -0,0 +1,25 @@
+program AdvLED_Demo;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}
+  cthreads,
+  {$ENDIF}
+  {$IFDEF HASAMIGA}
+  athreads,
+  {$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, Main
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  RequireDerivedFormResource:=True;
+  Application.Scaled:=True;
+  Application.Initialize;
+  Application.CreateForm(TForm1, Form1);
+  Application.Run;
+end.
+

components/industrialstuff/Example/AdvLED/main.lfm

@@ -0,0 +1,55 @@
+object Form1: TForm1
+  Left = 338
+  Height = 178
+  Top = 128
+  Width = 268
+  Caption = 'Form1'
+  ClientHeight = 178
+  ClientWidth = 268
+  LCLVersion = '2.3.0.0'
+  object Button1: TButton
+    Left = 128
+    Height = 25
+    Top = 128
+    Width = 101
+    AutoSize = True
+    Caption = 'Flash (100 ms)'
+    Enabled = False
+    OnClick = Button1Click
+    TabOrder = 0
+  end
+  object AdvLed1: TAdvLed
+    Left = 56
+    Height = 24
+    Top = 64
+    Width = 24
+    State = lsDisabled
+    Blink = False
+  end
+  object RadioGroup1: TRadioGroup
+    Left = 128
+    Height = 100
+    Top = 16
+    Width = 112
+    AutoFill = True
+    Caption = 'State'
+    ChildSizing.LeftRightSpacing = 6
+    ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+    ChildSizing.EnlargeVertical = crsHomogenousChildResize
+    ChildSizing.ShrinkHorizontal = crsScaleChilds
+    ChildSizing.ShrinkVertical = crsScaleChilds
+    ChildSizing.Layout = cclLeftToRightThenTopToBottom
+    ChildSizing.ControlsPerLine = 1
+    ClientHeight = 80
+    ClientWidth = 108
+    ItemIndex = 0
+    Items.Strings = (
+      'disabled'
+      'off'
+      'on'
+      'blink (500 ms)'
+    )
+    OnClick = RadioGroup1Click
+    TabOrder = 1
+  end
+end

components/industrialstuff/Example/AdvLED/main.pas

@@ -0,0 +1,55 @@
+unit Main;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
+  AdvLed;
+
+type
+  
+  { TForm1 }
+
+  TForm1 = class(TForm)
+    AdvLed1: TAdvLed;
+    Button1: TButton;
+    RadioGroup1: TRadioGroup;
+    procedure Button1Click(Sender: TObject);
+    procedure RadioGroup1Click(Sender: TObject);
+  private
+
+  public
+
+  end;
+
+var
+  Form1: TForm1;
+
+implementation
+
+{$R *.lfm}
+
+{ TForm1 }
+
+procedure TForm1.Button1Click(Sender: TObject);
+begin
+  AdvLed1.Flash(100);
+end;
+
+procedure TForm1.RadioGroup1Click(Sender: TObject);
+begin
+  AdvLed1.BlinkDuration := 500;
+  AdvLed1.Blink := false;
+  case RadioGroup1.ItemIndex of
+    0: AdvLed1.State := lsDisabled;
+    1: AdvLed1.State := lsOFF;
+    2: AdvLed1.State := lsON;
+    3: AdvLed1.Blink := true;
+  end;
+  Button1.Enabled := RadioGroup1.ItemIndex > 0;
+end;
+
+end.
+

components/industrialstuff/source/AdvLed.pas

@@ -40,6 +40,7 @@ type
     FOnChange: TLedStateEvent;
     FGlyphs: TAdvLedGlyphs;
     FBlinkTimer: TTimer;
+    FFlashTimer: TTimer;
     function GetGlyph(const Index: Integer): TLedBitmap;
     function GetBlinkDuration: Integer;
     procedure SetKind(const Value: TLedKind);
@@ -53,6 +54,7 @@ type
     procedure BitmapNeeded;
     procedure DoTimer(Sender: TObject);
     procedure GlyphChanged(Sender: TObject);
+    procedure DoFlashTimer(Sender: TObject);
 
   protected
     FlipFLop : Boolean;
@@ -63,6 +65,8 @@ type
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
+    procedure Flash(ADuration: integer);
+    procedure Toggle;
 
   published
     // kind property must be published before GlyphOn, GlyphOff,GlyphDisable
@@ -163,6 +167,9 @@ begin
   FBlinkTimer := TTimer.Create(nil);
   FBlinkTimer.OnTimer := @DoTimer;
   FBlinkTimer.Enabled := false;
+  FFlashTimer := TTimer.Create(nil);
+  FFlashTimer.OnTimer := @DoFlashTimer;
+  FFlashTimer.Enabled := false;
   //if (csDesigning in ComponentState) then
   BitmapNeeded;
 end;
@@ -171,6 +178,7 @@ end;
 destructor TAdvLed.Destroy;
 begin
   FBlinkTimer.Free;
+  FFlashTimer.Free;
   FGlyphs[lsOn].Free;
   FGlyphs[lsOff].Free;
   FGlyphs[lsDisabled].Free;
@@ -200,12 +208,25 @@ end;
 procedure TAdvLed.DoTimer(Sender: TObject);
 begin
   if FlipFlop then
-    SetState(lsOn )
+    SetState(lsOn)
   else
     SetState(lsoff);
   FlipFlop := Not FlipFlop;
 end;
 
+procedure TAdvLed.DoFlashTimer(Sender: TObject);
+begin
+  FFlashTimer.Enabled:= False;
+  Toggle;
+end;
+
+procedure TAdvLed.Flash(ADuration: integer);
+begin
+  Toggle;
+  FFlashTimer.Interval := ADuration;
+  FFlashTimer.Enabled := true;
+end;
+
 // trigger OnChangeEvent
 procedure TAdvLed.DoChange(AState: TLedState);
 begin
@@ -273,6 +294,15 @@ begin
   Picture.Assign(BitmapToDraw);
 end;
 
+procedure TAdvLed.Toggle;
+begin
+  if FState = lsOff then
+    SetState(lsOn)
+  else 
+  if FState = lsOn then
+    SetState(lsOff);
+end;
+
 function TAdvLed.GetGlyph(const Index: Integer): TLedBitmap;
 begin
   case Index of