diff --git a/.gitignore b/.gitignore index 352f1f1..63f19ae 100644 --- a/.gitignore +++ b/.gitignore @@ -34,3 +34,5 @@ __history /Ex12/lib /Ex12Full/backup /Ex12Full/lib +/ExNotUseThreads/backup +/ExNotUseThreads/lib diff --git a/ExNotUseThreads/ExNotUseThreadsLaz.ico b/ExNotUseThreads/ExNotUseThreadsLaz.ico new file mode 100644 index 0000000..10c5fc1 Binary files /dev/null and b/ExNotUseThreads/ExNotUseThreadsLaz.ico differ diff --git a/ExNotUseThreads/ExNotUseThreadsLaz.lpi b/ExNotUseThreads/ExNotUseThreadsLaz.lpi new file mode 100644 index 0000000..096a9bd --- /dev/null +++ b/ExNotUseThreads/ExNotUseThreadsLaz.lpi @@ -0,0 +1,86 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="LCL"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="ExNotUseThreadsLaz.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="NotUseThreadsUnit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="Form1"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + <Unit> + <Filename Value="SplashFormUnit.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="SplashForm"/> + <ResourceBaseClass Value="Form"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="ExNotUseThreadsLaz"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/ExNotUseThreads/ExNotUseThreadsLaz.lpr b/ExNotUseThreads/ExNotUseThreadsLaz.lpr new file mode 100644 index 0000000..bda861a --- /dev/null +++ b/ExNotUseThreads/ExNotUseThreadsLaz.lpr @@ -0,0 +1,24 @@ +program ExNotUseThreadsLaz; + +{$mode objfpc}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + Forms, NotUseThreadsUnit, SplashFormUnit; + +{$R *.res} + +begin + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + Application.CreateForm(TForm1, Form1); + Application.Run; +end. + diff --git a/ExNotUseThreads/ExNotUseThreadsLaz.res b/ExNotUseThreads/ExNotUseThreadsLaz.res new file mode 100644 index 0000000..bb86af9 Binary files /dev/null and b/ExNotUseThreads/ExNotUseThreadsLaz.res differ diff --git a/ExNotUseThreads/NotUseThreadsUnit.lfm b/ExNotUseThreads/NotUseThreadsUnit.lfm new file mode 100644 index 0000000..f560900 --- /dev/null +++ b/ExNotUseThreads/NotUseThreadsUnit.lfm @@ -0,0 +1,54 @@ +object Form1: TForm1 + Left = 0 + Height = 129 + Top = 0 + Width = 635 + Caption = 'Демонстрация программы без использования дополнительных потоков' + ClientHeight = 129 + ClientWidth = 635 + Color = clBtnFace + Font.Color = clWindowText + Font.Height = -13 + Font.Name = 'Tahoma' + Position = poScreenCenter + object Label1: TLabel + Left = 16 + Height = 16 + Top = 16 + Width = 239 + Caption = 'Пример 1: использование Screen.Cursor' + Font.Color = clBlue + Font.Height = -13 + Font.Name = 'Tahoma' + ParentFont = False + end + object Label2: TLabel + Left = 16 + Height = 16 + Top = 88 + Width = 239 + Caption = 'Пример 2: использование splash-формы' + Font.Color = clBlue + Font.Height = -13 + Font.Name = 'Tahoma' + ParentFont = False + end + object btnRun1: TButton + Left = 272 + Height = 25 + Top = 13 + Width = 193 + Caption = 'Выполнить' + TabOrder = 0 + OnClick = btnRun1Click + end + object btnRun2: TButton + Left = 272 + Height = 25 + Top = 85 + Width = 193 + Caption = 'Выполнить' + TabOrder = 1 + OnClick = btnRun2Click + end +end diff --git a/ExNotUseThreads/NotUseThreadsUnit.pas b/ExNotUseThreads/NotUseThreadsUnit.pas index 1564315..7967205 100644 --- a/ExNotUseThreads/NotUseThreadsUnit.pas +++ b/ExNotUseThreads/NotUseThreadsUnit.pas @@ -1,10 +1,15 @@ +{$IFDEF FPC}{$CODEPAGE UTF8}{$H+}{$MODE DELPHI}{$ENDIF} unit NotUseThreadsUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, SplashFormUnit; + {$IFnDEF FPC} + Windows, Messages, + {$ELSE} + LCLIntf, LCLType, LMessages, + {$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, SplashFormUnit; type TForm1 = class(TForm) @@ -25,16 +30,20 @@ var implementation -{$R *.dfm} +{$IFnDEF FPC} + {$R *.dfm} +{$ELSE} + {$R *.lfm} +{$ENDIF} procedure TForm1.btnRun1Click(Sender: TObject); begin - btnRun1.Caption := '...'; + btnRun1.Caption := 'Ждите...'; Screen.Cursor := crSQLWait; try Sleep(10000); finally - btnRun1.Caption := ''; + btnRun1.Caption := 'Выполнить'; Screen.Cursor := crDefault; end; end; diff --git a/ExNotUseThreads/SplashFormUnit.lfm b/ExNotUseThreads/SplashFormUnit.lfm new file mode 100644 index 0000000..439c8a9 --- /dev/null +++ b/ExNotUseThreads/SplashFormUnit.lfm @@ -0,0 +1,31 @@ +object SplashForm: TSplashForm + Left = 0 + Top = 0 + Caption = 'SplashForm' + ClientHeight = 117 + ClientWidth = 414 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -16 + Font.Name = 'Tahoma' + Font.Style = [] + OnCreate = FormCreate + PixelsPerInch = 96 + object Panel1: TPanel + Left = 0 + Top = 0 + Width = 414 + Height = 117 + Align = alClient + BorderStyle = bsSingle + TabOrder = 0 + object Label1: TLabel + Left = 32 + Top = 48 + Width = 331 + Height = 19 + Caption = #1046#1076#1080#1090#1077'! '#1042#1099#1087#1086#1083#1085#1103#1077#1090#1089#1103' '#1076#1083#1080#1090#1077#1083#1100#1085#1072#1103' '#1086#1087#1077#1088#1072#1094#1080#1103'...' + end + end +end diff --git a/ExNotUseThreads/SplashFormUnit.pas b/ExNotUseThreads/SplashFormUnit.pas index 81f3b36..d08bae1 100644 --- a/ExNotUseThreads/SplashFormUnit.pas +++ b/ExNotUseThreads/SplashFormUnit.pas @@ -1,10 +1,15 @@ +{$IFDEF FPC}{$CODEPAGE UTF8}{$H+}{$MODE DELPHI}{$ENDIF} unit SplashFormUnit; interface uses - Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, - Dialogs, StdCtrls, ExtCtrls; + {$IFnDEF FPC} + Windows, Messages, + {$ELSE} + LCLIntf, LCLType, LMessages, + {$ENDIF} + SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TSplashForm = class(TForm) @@ -22,7 +27,11 @@ procedure HideSplashForm; implementation -{$R *.dfm} +{$IFnDEF FPC} + {$R *.dfm} +{$ELSE} + {$R *.lfm} +{$ENDIF} var GlobalSplashForm: TSplashForm; @@ -41,8 +50,8 @@ end; procedure TSplashForm.FormCreate(Sender: TObject); begin - BorderStyle := bsNone; // - Position := poOwnerFormCenter; // - + BorderStyle := bsNone; // Форма без рамки + Position := poOwnerFormCenter; // Форма отобразиться в середине формы-владельца FormStyle := fsStayOnTop; end;