jvcllaz: New component TJvAnimTitle

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6740 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2018-11-25 22:50:20 +00:00
parent 99295fcab0
commit c73847f18e
9 changed files with 261 additions and 10 deletions

View File

@ -1,3 +1,4 @@
tjvappanimatedicon.bmp tjvappanimatedicon.bmp
tjvformanimatedicon.bmp tjvformanimatedicon.bmp
tjvanimtitle.bmp
tjvformwallpaper.bmp tjvformwallpaper.bmp

Binary file not shown.

After

Width:  |  Height:  |  Size: 1.6 KiB

View File

@ -16,12 +16,12 @@ implementation
uses uses
Classes, //PropEdits, ComponentEditors, Classes, //PropEdits, ComponentEditors,
JvDsgnConsts, JvDsgnConsts,
JvAppAnimatedIcon, JvFormAnimatedIcon, JvFormWallPaper; JvAppAnimatedIcon, JvFormAnimatedIcon, JvAnimTitle, JvFormWallPaper;
procedure Register; procedure Register;
begin begin
RegisterComponents(RsPaletteJvcl, [ RegisterComponents(RsPaletteJvcl, [
TJvAppAnimatedIcon, TJvFormAnimatedIcon, TJvFormWallPaper TJvAppAnimatedIcon, TJvFormAnimatedIcon, TJvAnimTitle, TJvFormWallPaper
]); ]);
end; end;

View File

@ -3,17 +3,24 @@ object Form1: TForm1
Height = 344 Height = 344
Top = 128 Top = 128
Width = 937 Width = 937
Caption = 'Form1' Caption = 'F'
ClientHeight = 344 ClientHeight = 344
ClientWidth = 937 ClientWidth = 937
OnCreate = FormCreate OnCreate = FormCreate
LCLVersion = '2.1.0.0' LCLVersion = '2.1.0.0'
object ListView1: TListView object ListView1: TListView
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 8 Left = 8
Height = 305 Height = 305
Top = 31 Top = 31
Width = 921 Width = 921
Align = alClient Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
@ -27,12 +34,59 @@ object Form1: TForm1
Left = 8 Left = 8
Height = 15 Height = 15
Top = 8 Top = 8
Width = 921 Width = 233
Align = alTop
BorderSpacing.Around = 8 BorderSpacing.Around = 8
Caption = 'See animation in form and application icons' Caption = 'See animation in form and application icons'
ParentColor = False ParentColor = False
end end
object CheckBox1: TCheckBox
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrCenter
Left = 265
Height = 19
Top = 6
Width = 93
BorderSpacing.Left = 24
Caption = 'animated title'
Checked = True
OnChange = CheckBox1Change
State = cbChecked
TabOrder = 1
end
object CheckBox2: TCheckBox
AnchorSideLeft.Control = CheckBox1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrCenter
Left = 382
Height = 19
Top = 6
Width = 127
BorderSpacing.Left = 24
Caption = 'Animated form icon'
Checked = True
OnChange = CheckBox2Change
State = cbChecked
TabOrder = 2
end
object CheckBox3: TCheckBox
AnchorSideLeft.Control = CheckBox2
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrCenter
Left = 533
Height = 19
Top = 6
Width = 217
BorderSpacing.Left = 24
Caption = 'Animated application icon in task bar'
Checked = True
OnChange = CheckBox3Change
State = cbChecked
TabOrder = 3
end
object JvFormAnimatedIcon1: TJvFormAnimatedIcon object JvFormAnimatedIcon1: TJvFormAnimatedIcon
Icons = IconImages Icons = IconImages
Delay = 50 Delay = 50
@ -4150,4 +4204,10 @@ object Form1: TForm1
left = 80 left = 80
top = 129 top = 129
end end
object JvAnimTitle1: TJvAnimTitle
Title = 'Form1'
Delay = 100
left = 80
top = 192
end
end end

View File

@ -6,18 +6,25 @@ interface
uses uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
JvFormAnimatedIcon, JvAppAnimatedIcon; JvFormAnimatedIcon, JvAppAnimatedIcon, JvAnimTitle;
type type
{ TForm1 } { TForm1 }
TForm1 = class(TForm) TForm1 = class(TForm)
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
IconImages: TImageList; IconImages: TImageList;
JvAnimTitle1: TJvAnimTitle;
JvAppAnimatedIcon1: TJvAppAnimatedIcon; JvAppAnimatedIcon1: TJvAppAnimatedIcon;
JvFormAnimatedIcon1: TJvFormAnimatedIcon; JvFormAnimatedIcon1: TJvFormAnimatedIcon;
Label1: TLabel; Label1: TLabel;
ListView1: TListView; ListView1: TListView;
procedure CheckBox1Change(Sender: TObject);
procedure CheckBox2Change(Sender: TObject);
procedure CheckBox3Change(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
private private
@ -34,6 +41,9 @@ implementation
{ TForm1 } { TForm1 }
const
FORM_CAPTION = 'JvFormAnimation Demo';
procedure TForm1.FormCreate(Sender: TObject); procedure TForm1.FormCreate(Sender: TObject);
procedure AddItem(AIndex: Integer); procedure AddItem(AIndex: Integer);
@ -50,6 +60,25 @@ begin
JvAppAnimatedIcon1.Active := true; JvAppAnimatedIcon1.Active := true;
for i:=0 to IconImages.Count-1 do for i:=0 to IconImages.Count-1 do
AddItem(i); AddItem(i);
Checkbox1Change(nil);
end;
procedure TForm1.CheckBox1Change(Sender: TObject);
begin
JvAnimTitle1.Enabled := Checkbox1.Checked;
JvAnimTitle1.Title := FORM_CAPTION;
if not JvAnimTitle1.Enabled then Caption := FORM_CAPTION;
end;
procedure TForm1.CheckBox2Change(Sender: TObject);
begin
JvFormAnimatedIcon1.Active := Checkbox2.Checked;
end;
procedure TForm1.CheckBox3Change(Sender: TObject);
begin
JvAppAnimatedIcon1.Active := Checkbox3.Checked;
end; end;
end. end.

View File

@ -14,7 +14,7 @@
</SearchPaths> </SearchPaths>
</CompilerOptions> </CompilerOptions>
<Description Value="JVCL application forms (design time) containing form enhancement components: <Description Value="JVCL application forms (design time) containing form enhancement components:
- animated icons, form wallpaper - animated icons, animated title, form wallpaper
"/> "/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="4"/> <Version Major="1" Release="4"/>

View File

@ -13,11 +13,11 @@
</SearchPaths> </SearchPaths>
</CompilerOptions> </CompilerOptions>
<Description Value="JVCL Application Forms (Runtime) containing form enhancement components: <Description Value="JVCL Application Forms (Runtime) containing form enhancement components:
- animated icons, form wallpaper - animated icons, animated title, form wallpaper
"/> "/>
<License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/> <License Value="The JVCL is released in accordance with the MPL 1.1 license. To get your own copy or read it, go to http://www.mozilla.org/MPL/MPL-1.1.html. "/>
<Version Major="1" Release="4"/> <Version Major="1" Release="4"/>
<Files Count="3"> <Files Count="4">
<Item1> <Item1>
<Filename Value="..\run\JvAppFrm\JvFormAnimatedIcon.pas"/> <Filename Value="..\run\JvAppFrm\JvFormAnimatedIcon.pas"/>
<UnitName Value="JvFormAnimatedIcon"/> <UnitName Value="JvFormAnimatedIcon"/>
@ -30,6 +30,10 @@
<Filename Value="..\run\JvAppFrm\JvAppAnimatedIcon.pas"/> <Filename Value="..\run\JvAppFrm\JvAppAnimatedIcon.pas"/>
<UnitName Value="JvAppAnimatedIcon"/> <UnitName Value="JvAppAnimatedIcon"/>
</Item3> </Item3>
<Item4>
<Filename Value="..\run\JvAppFrm\JvAnimTitle.pas"/>
<UnitName Value="JvAnimTitle"/>
</Item4>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

View File

@ -0,0 +1,157 @@
{-----------------------------------------------------------------------------
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/MPL-1.1.html
Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.
The Original Code is: JvAnimTitle.PAS, released on 2001-02-28.
The Initial Developer of the Original Code is S�bastien Buysse [sbuysse att buypin dott com]
Portions created by S�bastien Buysse are Copyright (C) 2001 S�bastien Buysse.
All Rights Reserved.
Contributor(s): Michael Beck [mbeck att bigfoot dott com].
You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org
Known Issues:
-----------------------------------------------------------------------------}
// $Id$
unit JvAnimTitle;
{$mode objfpc}{$H+}
interface
uses
Classes, Controls, ExtCtrls, Forms;
type
TJvAnimTitle = class(TComponent)
private
FTimer: TTimer;
FEnabled: Boolean;
FTitle: string;
FCurrentTitle: string;
FDelay: Integer;
FSens: Boolean;
FForm: TCustomForm;
FBlink: Integer;
FBlinked: Integer;
FBlinking: Boolean;
procedure SetTitle(const NewTitle: string);
procedure SetEnabled(NewEnable: Boolean);
procedure SetDelay(NewDelay: Integer);
procedure AnimateTitle(Sender: TObject);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
published
property Title: string read FTitle write SetTitle;
property Enabled: Boolean read FEnabled write SetEnabled default False;
property Delay: Integer read FDelay write SetDelay default 50;
property Blink: Integer read FBlink write FBlink default 5;
end;
implementation
constructor TJvAnimTitle.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FEnabled := False;
FDelay := 50;
FBlink := 5;
FForm := GetParentForm(TControl(AOwner));
FTitle := FForm.Caption;
FSens := True;
FBlinking := False;
FBlinked := 0;
FTimer := TTimer.Create(Self);
FTimer.Enabled := FEnabled;
FTimer.Interval := FDelay;
FTimer.OnTimer := @AnimateTitle;
end;
destructor TJvAnimTitle.Destroy;
begin
FTimer.Free;
if not (csDestroying in FForm.ComponentState) then
FForm.Caption := FTitle;
inherited Destroy;
end;
procedure TJvAnimTitle.AnimateTitle(Sender: TObject);
begin
if FBlinking then
begin
// (rom) this is a bad implementation better try to manipulate
// (rom) the WM_GETTEXT and WM_SETTEXT to the Form window
if FForm.Caption = Title then
FForm.Caption := ''
else
begin
FForm.Caption := Title;
Inc(FBlinked);
if FBlinked >= Blink then
begin
FBlinking := False;
FBlinked := 0;
end;
end;
end
else
begin
if FSens then
begin
if Length(FCurrentTitle) = Length(Title) then
begin
FSens := False;
if Blink > 0 then
FBlinking := True;
end
else
FCurrentTitle := FCurrentTitle + Title[Length(FCurrentTitle) + 1];
end
else
if FCurrentTitle = '' then
FSens := True
else
SetLength(FCurrentTitle, Length(FCurrentTitle) - 1);
{$IFDEF UNIX}
if FCurrentTitle = '' then
FForm.Caption := ' ' // else caption becomes <1>
else
{$ENDIF UNIX}
FForm.Caption := FCurrentTitle;
end;
end;
procedure TJvAnimTitle.SetTitle(const NewTitle: string);
begin
FTitle := NewTitle;
FCurrentTitle := '';
FSens := True;
end;
procedure TJvAnimTitle.SetEnabled(NewEnable: Boolean);
begin
FEnabled := NewEnable;
FTimer.Enabled := FEnabled;
end;
procedure TJvAnimTitle.SetDelay(NewDelay: Integer);
begin
FDelay := NewDelay;
FTimer.Interval := FDelay;
end;
end.