Стартовый пул

This commit is contained in:
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions

View 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

View 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.

View 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>

View 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.