Стартовый пул
This commit is contained in:
134
LCLExtensions/tests/settimer/Unit1.lfm
Normal file
134
LCLExtensions/tests/settimer/Unit1.lfm
Normal file
@@ -0,0 +1,134 @@
|
||||
object MainForm: TMainForm
|
||||
Left = 409
|
||||
Height = 448
|
||||
Top = 218
|
||||
Width = 613
|
||||
HorzScrollBar.Page = 559
|
||||
VertScrollBar.Page = 447
|
||||
ActiveControl = ListBox1
|
||||
Caption = 'Test SetTimer'
|
||||
ClientHeight = 448
|
||||
ClientWidth = 613
|
||||
Position = poScreenCenter
|
||||
LCLVersion = '1.3'
|
||||
object ListBox1: TListBox
|
||||
Left = 8
|
||||
Height = 403
|
||||
Top = 8
|
||||
Width = 320
|
||||
Anchors = [akTop, akLeft, akBottom]
|
||||
ItemHeight = 0
|
||||
ScrollWidth = 318
|
||||
TabOrder = 0
|
||||
end
|
||||
object Button1: TButton
|
||||
Left = 240
|
||||
Height = 30
|
||||
Top = 414
|
||||
Width = 88
|
||||
Anchors = [akLeft, akBottom]
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Clear'
|
||||
OnClick = Button1Click
|
||||
TabOrder = 1
|
||||
end
|
||||
object SetTimer1Button: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 8
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Set Timer 1'
|
||||
OnClick = SetTimer1ButtonClick
|
||||
TabOrder = 2
|
||||
end
|
||||
object SetTimer2Button: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 48
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Set Timer 2'
|
||||
OnClick = SetTimer2ButtonClick
|
||||
TabOrder = 3
|
||||
end
|
||||
object SetTimer3Button: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 88
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Set Timer 3'
|
||||
OnClick = SetTimer3ButtonClick
|
||||
TabOrder = 4
|
||||
end
|
||||
object KillTimer1Button: TButton
|
||||
Left = 481
|
||||
Height = 28
|
||||
Top = 8
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Kill'
|
||||
OnClick = KillTimer1ButtonClick
|
||||
TabOrder = 5
|
||||
end
|
||||
object KillTimer2Button: TButton
|
||||
Left = 481
|
||||
Height = 28
|
||||
Top = 48
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Kill'
|
||||
OnClick = KillTimer2ButtonClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object KillTimer3Button: TButton
|
||||
Left = 481
|
||||
Height = 60
|
||||
Top = 88
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Kill'
|
||||
OnClick = KillTimer3ButtonClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object SetTimer3bButton: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 120
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Set Timer 3b'
|
||||
OnClick = SetTimer3bButtonClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object SetTimerDestroyButton: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 224
|
||||
Width = 256
|
||||
Caption = 'Set Timer and Destroy'
|
||||
OnClick = SetTimerDestroyButtonClick
|
||||
TabOrder = 9
|
||||
end
|
||||
object SetGlobalTimerButton: TButton
|
||||
Left = 345
|
||||
Height = 28
|
||||
Top = 160
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Set Global Timer'
|
||||
OnClick = SetGlobalTimerButtonClick
|
||||
TabOrder = 10
|
||||
end
|
||||
object KillGlobalTimerButton1: TButton
|
||||
Left = 481
|
||||
Height = 28
|
||||
Top = 160
|
||||
Width = 120
|
||||
BorderSpacing.InnerBorder = 4
|
||||
Caption = 'Kill'
|
||||
OnClick = KillGlobalTimerButton1Click
|
||||
TabOrder = 11
|
||||
end
|
||||
end
|
182
LCLExtensions/tests/settimer/Unit1.pas
Normal file
182
LCLExtensions/tests/settimer/Unit1.pas
Normal file
@@ -0,0 +1,182 @@
|
||||
unit Unit1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||
Buttons, delphicompat, LMessages, LCLType;
|
||||
|
||||
type
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
TMainForm = class(TForm)
|
||||
Button1: TButton;
|
||||
KillGlobalTimerButton1: TButton;
|
||||
SetGlobalTimerButton: TButton;
|
||||
SetTimerDestroyButton: TButton;
|
||||
SetTimer1Button: TButton;
|
||||
SetTimer2Button: TButton;
|
||||
SetTimer3Button: TButton;
|
||||
KillTimer1Button: TButton;
|
||||
KillTimer2Button: TButton;
|
||||
KillTimer3Button: TButton;
|
||||
SetTimer3bButton: TButton;
|
||||
ListBox1: TListBox;
|
||||
procedure Button1Click(Sender: TObject);
|
||||
procedure KillGlobalTimerButton1Click(Sender: TObject);
|
||||
procedure SetGlobalTimerButtonClick(Sender: TObject);
|
||||
procedure SetTimer1ButtonClick(Sender: TObject);
|
||||
procedure SetTimer2ButtonClick(Sender: TObject);
|
||||
procedure SetTimer3ButtonClick(Sender: TObject);
|
||||
procedure KillTimer1ButtonClick(Sender: TObject);
|
||||
procedure KillTimer2ButtonClick(Sender: TObject);
|
||||
procedure KillTimer3ButtonClick(Sender: TObject);
|
||||
procedure SetTimer3bButtonClick(Sender: TObject);
|
||||
procedure SetTimerDestroyButtonClick(Sender: TObject);
|
||||
protected
|
||||
procedure WMTimer(var Message: TLMTimer); message LM_TIMER;
|
||||
private
|
||||
FGlobalTimer: PtrUInt;
|
||||
procedure TimerCallback(AId: PtrUInt);
|
||||
procedure TimerCallbackGlobal(AId: PtrUInt);
|
||||
procedure TimerCallbackOther(AId: PtrUInt);
|
||||
{ private declarations }
|
||||
public
|
||||
{ public declarations }
|
||||
end;
|
||||
|
||||
var
|
||||
MainForm: TMainForm;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
uses
|
||||
strutils;
|
||||
|
||||
const
|
||||
Timer1 = 1;
|
||||
Timer2 = 2;
|
||||
Timer3 = 3;
|
||||
|
||||
{ TMainForm }
|
||||
|
||||
procedure TMainForm.Button1Click(Sender: TObject);
|
||||
begin
|
||||
ListBox1.Clear;
|
||||
end;
|
||||
|
||||
procedure TMainForm.KillGlobalTimerButton1Click(Sender: TObject);
|
||||
begin
|
||||
if FGlobalTimer <> 0 then
|
||||
begin
|
||||
KillTimer(0, FGlobalTimer);
|
||||
FGlobalTimer := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetGlobalTimerButtonClick(Sender: TObject);
|
||||
begin
|
||||
FGlobalTimer := SetTimer(0,FGlobalTimer,2000,@TimerCallbackGlobal);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetTimer1ButtonClick(Sender: TObject);
|
||||
begin
|
||||
SetTimer(Handle,Timer1,1000,nil);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetTimer2ButtonClick(Sender: TObject);
|
||||
begin
|
||||
SetTimer(Handle,Timer2,2000,nil);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetTimer3ButtonClick(Sender: TObject);
|
||||
begin
|
||||
SetTimer(Handle,Timer3,3000,@TimerCallback);
|
||||
end;
|
||||
|
||||
procedure TMainForm.KillTimer1ButtonClick(Sender: TObject);
|
||||
begin
|
||||
KillTimer(Handle,Timer1);
|
||||
end;
|
||||
|
||||
procedure TMainForm.KillTimer2ButtonClick(Sender: TObject);
|
||||
begin
|
||||
KillTimer(Handle,Timer2);
|
||||
end;
|
||||
|
||||
procedure TMainForm.KillTimer3ButtonClick(Sender: TObject);
|
||||
begin
|
||||
KillTimer(Handle,Timer3);
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetTimer3bButtonClick(Sender: TObject);
|
||||
begin
|
||||
SetTimer(Handle,Timer3,3000,@TimerCallbackOther);
|
||||
end;
|
||||
|
||||
type
|
||||
|
||||
{ TMyButton }
|
||||
|
||||
TMyButton = class(TButton)
|
||||
protected
|
||||
procedure WMTimer(var Message: TLMTimer); message LM_TIMER;
|
||||
end;
|
||||
|
||||
{ TMyButton }
|
||||
|
||||
procedure TMyButton.WMTimer(var Message: TLMTimer);
|
||||
begin
|
||||
MainForm.ListBox1.Items.Add('WMTimer - Released Button (Should Not Be Fired)');
|
||||
end;
|
||||
|
||||
procedure TMainForm.SetTimerDestroyButtonClick(Sender: TObject);
|
||||
var
|
||||
Button: TButton;
|
||||
begin
|
||||
Button := TButton.Create(nil);
|
||||
try
|
||||
Button.Parent := Self;
|
||||
Button.Visible := True;
|
||||
SetTimer(Button.Handle, Timer3, 1000, nil);
|
||||
finally
|
||||
Button.Destroy;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMainForm.WMTimer(var Message: TLMTimer);
|
||||
var
|
||||
AStr: String;
|
||||
begin
|
||||
case Message.TimerID of
|
||||
Timer1: AStr:='Timer1 called';
|
||||
Timer2: AStr:='Timer2 called';
|
||||
Timer3: AStr:='Timer3 called';
|
||||
else
|
||||
AStr:='TimerID not identified: '+IntToStr(Message.TimerID);
|
||||
end;
|
||||
ListBox1.Items.Add('WMTimer - '+AStr);
|
||||
end;
|
||||
|
||||
procedure TMainForm.TimerCallback(AId: PtrUInt);
|
||||
begin
|
||||
ListBox1.Items.Add('TimerCallback called');
|
||||
end;
|
||||
|
||||
procedure TMainForm.TimerCallbackGlobal(AId: PtrUInt);
|
||||
begin
|
||||
ListBox1.Items.Add('TimerCallbackGlobal called' + IfThen(AId <> FGlobalTimer, ' ERROR: ID <> GlobalTimer'));
|
||||
end;
|
||||
|
||||
procedure TMainForm.TimerCallbackOther(AId: PtrUInt);
|
||||
begin
|
||||
ListBox1.Items.Add('TimerCallbackOther called');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
84
LCLExtensions/tests/settimer/project1.lpi
Normal file
84
LCLExtensions/tests/settimer/project1.lpi
Normal file
@@ -0,0 +1,84 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="9"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<LRSInOutputDirectory Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
</General>
|
||||
<VersionInfo>
|
||||
<StringTable ProductVersion=""/>
|
||||
</VersionInfo>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<IgnoreBinaries Value="False"/>
|
||||
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<FormatVersion Value="1"/>
|
||||
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
|
||||
</local>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="2">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<PackageName Value="lclextensions_package"/>
|
||||
</Item2>
|
||||
</RequiredPackages>
|
||||
<Units Count="2">
|
||||
<Unit0>
|
||||
<Filename Value="project1.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="Unit1.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="MainForm"/>
|
||||
<HasResources Value="True"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
<UnitName Value="Unit1"/>
|
||||
</Unit1>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testsettimer"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Parsing>
|
||||
<SyntaxOptions>
|
||||
<UseAnsiStrings Value="False"/>
|
||||
</SyntaxOptions>
|
||||
</Parsing>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="2">
|
||||
<Item1>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item2>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
20
LCLExtensions/tests/settimer/project1.lpr
Normal file
20
LCLExtensions/tests/settimer/project1.lpr
Normal file
@@ -0,0 +1,20 @@
|
||||
program project1;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms
|
||||
{ add your units here }, Unit1;
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TMainForm, MainForm);
|
||||
Application.Run;
|
||||
end.
|
||||
|
Reference in New Issue
Block a user