From 074605a212aa3fe0c1d9be74ddbad26a62a8d876 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Wed, 16 Feb 2022 23:23:31 +0000 Subject: [PATCH] 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 --- .../Example/AdvLED/AdvLED_Demo.lpi | 86 +++++++++++++++++++ .../Example/AdvLED/AdvLED_Demo.lpr | 25 ++++++ .../industrialstuff/Example/AdvLED/main.lfm | 55 ++++++++++++ .../industrialstuff/Example/AdvLED/main.pas | 55 ++++++++++++ components/industrialstuff/source/AdvLed.pas | 32 ++++++- 5 files changed, 252 insertions(+), 1 deletion(-) create mode 100644 components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi create mode 100644 components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpr create mode 100644 components/industrialstuff/Example/AdvLED/main.lfm create mode 100644 components/industrialstuff/Example/AdvLED/main.pas diff --git a/components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi b/components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi new file mode 100644 index 000000000..943cde908 --- /dev/null +++ b/components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpi @@ -0,0 +1,86 @@ + + + + + + + + + + + + <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> diff --git a/components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpr b/components/industrialstuff/Example/AdvLED/AdvLED_Demo.lpr new file mode 100644 index 000000000..b8079c56c --- /dev/null +++ b/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. + diff --git a/components/industrialstuff/Example/AdvLED/main.lfm b/components/industrialstuff/Example/AdvLED/main.lfm new file mode 100644 index 000000000..a50169b47 --- /dev/null +++ b/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 diff --git a/components/industrialstuff/Example/AdvLED/main.pas b/components/industrialstuff/Example/AdvLED/main.pas new file mode 100644 index 000000000..13f313f21 --- /dev/null +++ b/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. + diff --git a/components/industrialstuff/source/AdvLed.pas b/components/industrialstuff/source/AdvLed.pas index 6628ec45a..3a5dbbb30 100644 --- a/components/industrialstuff/source/AdvLed.pas +++ b/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