paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-13 23:19:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

Examples: Replace lfm-less MessageDialogs demo by version with lfm form.

Browse Source
This commit is contained in:
wp_xyz 2021-12-28 00:09:31 +01:00
parent c585bae868
commit dc62098696
5 changed files with 137 additions and 100 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
examples/messagedialogs.lpi
View File

@ -2,46 +2,60 @@
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
<LRSInOutputDirectory Value="False"/>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="messagedialogs"/>
<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"/>
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="1">
<Units Count="2">
<Unit0>
<Filename Value="messagedialogs.pp"/>
<Filename Value="messagedialogs.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="MessagDialogs"/>
<IsVisibleTab Value="True"/>
<TopLine Value="40"/>
<CursorPos X="42" Y="59"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit0>
<Unit1>
<Filename Value="messagedialogsfrm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="MessageDialogsFrm"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="messagedialogs"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
@ -50,4 +64,17 @@
</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>

25
examples/messagedialogs.lpr Normal file
View File

@ -0,0 +1,25 @@
program messagedialogs;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}
cthreads,
{$ENDIF}
{$IFDEF HASAMIGA}
athreads,
{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, MessageDialogsFrm
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

85
examples/messagedialogs.pp
View File

@ -1,85 +0,0 @@
{ ***************************************************************************
MessageDialogs - example
------------------------
Just a simple example to show & verify functionality of the lazarus
functions to deal with message dialogs.
by Stefan Hille <stoppok@osibisa.ms.sub.org>
****************************************************************************
***************************************************************************
* *
* This source is free software; you can redistribute it and/or modify *
* it under the terms of the GNU General Public License as published by *
* the Free Software Foundation; either version 2 of the License, or *
* (at your option) any later version. *
* *
* This code is distributed in the hope that it will be useful, but *
* WITHOUT ANY WARRANTY; without even the implied warranty of *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
* General Public License for more details. *
* *
* A copy of the GNU General Public License is available on the World *
* Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
* obtain it by writing to the Free Software Foundation, *
* Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
* *
***************************************************************************
}
Program MessagDialogs;
{$mode objfpc}{$H+}
uses Interfaces, Classes, Forms, Dialogs, Buttons, StdCtrls, LazLogger;
type
TMainForm = class(TForm)
private
protected
public
button1 : TButton;
constructor Create(AOwner: TComponent); override;
procedure button1Click(Sender : TObject);
end;
var
MainForm : TMainForm;
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner, 1);
Caption := 'Message Show';
Width := 200;
Height := 75;
Left := 200;
Top := 200;
button1 := TButton.Create(Self);
button1.OnClick := @button1click;
button1.Parent := Self;
button1.left := (width - 85) div 2 ;
button1.top := (height - 32) div 2;
button1.width := 85;
button1.height := 32;
button1.caption := 'Start Show';
button1.Show;
end;
procedure TMainForm.Button1Click(Sender : TObject);
begin
ShowMessage ('First simple test!');
DebugLn('Go to second dialog');
MessageDlg ('Caption', 'Two buttons now ...', mtError, [mbOK,mbCancel], 0);
MessageDlg ('Warning, not fully implemented', mtWarning, [mbYes, mbNo, mbOK,mbCancel], 0);
ShowMessageFmt ('The show will end now'+LineEnding+'%s'+LineEnding+'Good bye!!!', [MainForm.Caption]);
close;
end;
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

20
examples/messagedialogsfrm.lfm Normal file
View File

@ -0,0 +1,20 @@
object MainForm: TMainForm
Left = 200
Height = 75
Top = 200
Width = 200
Caption = 'Message Show'
ClientHeight = 75
ClientWidth = 200
OnCreate = FormCreate
LCLVersion = '2.3.0.0'
object Button1: TButton
Left = 69
Height = 32
Top = 22
Width = 85
Caption = 'Start Show'
OnClick = Button1Click
TabOrder = 0
end
end

50
examples/messagedialogsfrm.pas Normal file
View File

@ -0,0 +1,50 @@
unit MessageDialogsFrm;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, LazLogger;
type
{ TMainForm }
TMainForm = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
Button1.Left := (Width - Button1.Width) div 2;
Button1.Top := (Height - Button1.Height) div 2;
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin
ShowMessage('First simple test!');
DebugLn('Go to second dialog');
MessageDlg('Caption', 'Two buttons now ...', mtError, [mbOK, mbCancel], 0);
MessageDlg('Warning, not fully implemented', mtWarning, [mbYes, mbNo, mbOK, mbCancel], 0);
ShowMessageFmt('The show will end now'+LineEnding+'%s'+LineEnding+'Good bye!!!', [MainForm.Caption]);
close;
end;
end.