babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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

Browse Source
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
Download Patch File Download Diff File Expand all files Collapse all files

BIN
splashabout_component/exampleapp/bitmapmaskmono.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 38 KiB

BIN
splashabout_component/exampleapp/cockroach.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 29 KiB

BIN
splashabout_component/exampleapp/cockroachmask.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 35 KiB

BIN
splashabout_component/exampleapp/golfballs.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 68 KiB

BIN
splashabout_component/exampleapp/golfballsmask.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 52 KiB

BIN
splashabout_component/exampleapp/golfml.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 364 KiB

15
splashabout_component/exampleapp/license.txt Normal file
View File

@@ -0,0 +1,15 @@
This is a custom license text file which must be
called 'license.txt' and be in the same folder as the executable.
You can put any text you like in here.
Certain text (without the spaces) is replaced automatically by the value of a property.
All instances of < name of author > are replaced with the Author property
All instances of < contact > are replaced with the SupportContact property
All instances of < copyright holders > are replaced with the Copyright property
All instances of < year > are replaced with the current date
Read the licence.txt included with the example application for details.
Set the properties to see the example below:
Author: <name of author>
Copyright: <copyright holders>
Support : <contact>
Released: <year>
(c)<year> by <copyright holders>

12
splashabout_component/exampleapp/linux/ppas.sh Normal file
View File

@@ -0,0 +1,12 @@
#!/bin/sh
DoExitAsm ()
{ echo "An error occurred while assembling $1"; exit 1; }
DoExitLink ()
{ echo "An error occurred while linking $1"; exit 1; }
echo Linking project1
OFS=$IFS
IFS="
"
/usr/bin/ld -b elf32-i386 -m elf_i386 --dynamic-linker=/lib/ld-linux.so.2 -L. -o project1 link.res
if [ $? != 0 ]; then DoExitLink project1; fi
IFS=$OFS

BIN
splashabout_component/exampleapp/linux/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 56 KiB

137
splashabout_component/exampleapp/linux/project1.lpi Normal file
View File

@@ -0,0 +1,137 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<MainUnit Value="0"/>
<Title Value="Application Title"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
<Icon Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<UseVersionInfo Value="True"/>
<MajorVersionNr Value="1"/>
<BuildNr Value="1"/>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1" Active="Default">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="splashabout"/>
<MinVersion Major="1" Minor="3" Build="1" Valid="True"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
<UsageCount Value="20"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="1"/>
<CursorPos X="17" Y="40"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../usplashabout.pas"/>
<UnitName Value="usplashabout"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="488"/>
<CursorPos X="31" Y="499"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="5" HistoryIndex="4">
<Position1>
<Filename Value="unit1.pas"/>
<Caret Line="33" Column="18" TopLine="1"/>
</Position1>
<Position2>
<Filename Value="unit1.pas"/>
<Caret Line="9" Column="59" TopLine="1"/>
</Position2>
<Position3>
<Filename Value="unit1.pas"/>
<Caret Line="39" Column="17" TopLine="1"/>
</Position3>
<Position4>
<Filename Value="unit1.pas"/>
<Caret Line="40" Column="17" TopLine="1"/>
</Position4>
<Position5>
<Filename Value="unit1.pas"/>
<Caret Line="39" Column="17" TopLine="1"/>
</Position5>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerMessages>
<UseMsgFile Value="True"/>
</CompilerMessages>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

21
splashabout_component/exampleapp/linux/project1.lpr Normal file
View File

@@ -0,0 +1,21 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, splashabout
{ you can add units after this };
{$R *.res}
begin
Application.Title:='Application Title';
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

50
splashabout_component/exampleapp/linux/unit1.lfm Normal file
View File

@@ -0,0 +1,50 @@
object Form1: TForm1
Left = 423
Height = 129
Top = 317
Width = 193
BorderStyle = bsDialog
Caption = 'Form Caption'
ClientHeight = 129
ClientWidth = 193
OnCreate = FormCreate
Position = poDesktopCenter
LCLVersion = '0.9.30'
object Button1: TButton
Left = 16
Height = 25
Top = 24
Width = 75
Caption = 'About'
OnClick = Button1Click
TabOrder = 0
end
object Button2: TButton
Left = 104
Height = 25
Top = 24
Width = 75
Caption = 'Splash'
OnClick = Button2Click
TabOrder = 1
end
object BitBtn1: TBitBtn
Left = 64
Height = 30
Top = 72
Width = 75
Caption = '&Close'
Kind = bkClose
TabOrder = 2
end
object SplashAbout1: TSplashAbout
Font.Height = -13
UserTitle = 'My Application'
ShowDescription = False
FormSplashHeight = 280
ShowCreditButton = True
CreditsTextfileName = 'credits.txt'
left = 31
top = 73
end
end

55
splashabout_component/exampleapp/linux/unit1.pas Normal file
View File

@@ -0,0 +1,55 @@
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons, usplashabout;
type
{ TForm1 }
TForm1 = class(TForm)
BitBtn1: TBitBtn;
Button1: TButton;
Button2: TButton;
SplashAbout1: TSplashAbout;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
SplashAbout1.ShowSplash;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SplashAbout1.ShowAbout;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
SplashAbout1.ShowSplash;
end;
end.

BIN
splashabout_component/exampleapp/project1.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 134 KiB

192
splashabout_component/exampleapp/project1.lpi Normal file
View File

@@ -0,0 +1,192 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="Application Title"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<XPManifest>
<DpiAware Value="True"/>
<UIAccess Value="True"/>
</XPManifest>
<Icon Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<UseVersionInfo Value="True"/>
<AutoIncrementBuild Value="True"/>
<MajorVersionNr Value="1"/>
<MinorVersionNr Value="2"/>
<BuildNr Value="8"/>
<StringTable CompanyName="by minesadorada@charcodelvalle.com" FileDescription="Example application to demonstrate SplashAbout component" LegalCopyright="LGPL license" ProductVersion="Product"/>
</VersionInfo>
<BuildModes Count="3">
<Item1 Name="Default" Default="True"/>
<Item2 Name="Debug">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<IncludeAssertionCode Value="True"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<Checks>
<IOChecks Value="True"/>
<RangeChecks Value="True"/>
<OverflowChecks Value="True"/>
<StackChecks Value="True"/>
</Checks>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
</CodeGeneration>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
<UseExternalDbgSyms Value="True"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item2>
<Item3 Name="Release">
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="3"/>
</Optimizations>
</CodeGeneration>
<Linking>
<LinkSmart Value="True"/>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</Item3>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="4">
<Item1>
<PackageName Value="LazControls"/>
</Item1>
<Item2>
<PackageName Value="scrolltext"/>
</Item2>
<Item3>
<PackageName Value="splashabout"/>
</Item3>
<Item4>
<PackageName Value="LCL"/>
</Item4>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="project1.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="project1"/>
</Unit0>
<Unit1>
<Filename Value="unit1.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Unit1"/>
</Unit1>
<Unit2>
<Filename Value="ustringlisteditor.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="frm_StringListEditor"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="uStringListEditor"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="project1"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="."/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<TargetCPU Value="i386"/>
<TargetOS Value="win32"/>
</CodeGeneration>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

22
splashabout_component/exampleapp/project1.lpr Normal file
View File

@@ -0,0 +1,22 @@
program project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Unit1, lazcontrols, uStringListEditor;
{$R *.res}
begin
Application.Title:='Application Title';
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.CreateForm(Tfrm_StringListEditor, frm_StringListEditor);
Application.Run;
end.

66
splashabout_component/exampleapp/readme.txt Normal file
View File

@@ -0,0 +1,66 @@
==SplashAbout Properties Tester==
Once splashabout has been installed on your component palette, then project1 should compile in windows and linux.
Note: the compiler messages 'Warning: Symbol x is not portable' are not errors.
It is because the shaped 'splash' screen features are unavailable outside the
Windows environment, and the corresponding properties are tagged as such.
I have included some sample graphic files to demonstrate the external file options
cockroach.bmp/jpg, golfballs.bmp/jpg and sunflower.bmp/jpg are
MaskColorImage and MaskMonoImage pairs
IMPORTANT: if you choose to specify external files, then you
MUST deploy them with your executable in the same folder
If you choose Graphics=saResources (default) then no external files are required.
Open license.txt to see how to write a user-defined license.
Try changing the TitleStyle, Graphics and MaskType properties to experiment
==If you are reading this via the [Help] button in the SplashAbout properties tester Application==
The SplashAbout tester displays all the current properties for the loaded SplashAbout1 component.
All changes you make will only last whilst the app is open.
If you want the app to load with your own property values, then open
up the mainform (Unit1) of the app and click the SplashAbout component
in order to make permanent changes via the Object Inspector.
The purpose of the 'SplashAbout properties tester' is so that you can
experiment with the many properties of SplashAbout, testing
(via the [Test Splash] and [Test About] buttons) until you are
familiar with configuring the component.
Change one property at a time, than click the [Test Splash] and [Test About]
buttons to see the effect of your changes. Remember to test the [Credits]
and [License] buttons on the About dialog as well.
You can also use it as a prototyper for your own
application's Splash and About screens.
If you choose to edit 'license.txt' and clear it's contents before saving it,
then the original 'license.txt' will be backed up to 'license.txt.bak'
Thus, you can restore the original example if you wish at a later date.
To make a MaskMonoImage
======================
In an image editor (I used Paint Shop Pro) reduce the palette to 2 colours and save as a BMP file (Not RLEncoded)
Black=transparent to the desktop
White=transparent to the splash window background (can be a solid colour or a BackgroundImage or a MaskPImage)
Note: If a MaskColorImage is specified, it hides the BackGroundImage in the splash screen (but not the About dialog)
and also supresses the text display on the splash screen (see below)
To make a MaskMonoImage and MaskColorImage pair
==========================================
For the most dramatic effect, find an strong image which fits fully within a square window
without touching the edges (compare images 'cockroach' and 'golfballs' with 'sunflower')
Using a paint program isolate the image on a white background and save it as a jpg
Using a paint program, make the image pure black, reduce the colour pallete to 2 and save it as a BMP
Set the properties:
MaskType=saUserImage
Graphics=saResources
BitmapMaskColor=your jpg file
BitmapMaskMono=your bmp file
If all this looks complicated - just experiment with the properties and images provided!

BIN
splashabout_component/exampleapp/ski.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 56 KiB

BIN
splashabout_component/exampleapp/splash.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 21 KiB

BIN
splashabout_component/exampleapp/splash1.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 21 KiB

BIN
splashabout_component/exampleapp/sunflower.jpg Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 55 KiB

BIN
splashabout_component/exampleapp/sunflowermask.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 22 KiB

46778
splashabout_component/exampleapp/unit1.lfm Normal file
View File

File diff suppressed because it is too large Load Diff

729
splashabout_component/exampleapp/unit1.pas Normal file
View File

@@ -0,0 +1,729 @@
{
***************************************************************************
* *
* 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *
* *
***************************************************************************
= Example application for the SplashAbout component
= Gordon Bamber
= minesadorada@gmail.com
= June 2014
=
= Use this app to experiment with different Splash screens and About dialogs
=
= Note: All external files MUST be deployed with your application in the same folder
}
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, usplashabout, Forms, Controls, FileUtil, Graphics, Dialogs,
Buttons, ExtCtrls, StdCtrls, ExtDlgs, Menus, Lresources,uStringListEditor;
type
{ TForm1 }
TForm1 = class(TForm)
cmd_Help: TBitBtn;
cmd_EditLicenseTxt: TButton;
cmd_Description: TButton;
cmd_EditCreditsTxt: TButton;
cmd_SetFont: TButton;
cmd_CreditsLines: TButton;
cmd_SetAuthor: TButton;
cmd_SetOrganisation: TButton;
cmd_SetSupportContact: TButton;
cmd_SetUserTitle: TButton;
CheckGroupUseExternalFile: TCheckGroup;
cmd_BitmapBackground: TButton;
cmd_Icon: TButton;
cmd_BitmapMaskMono: TButton;
cmd_BitmapMaskColor: TButton;
cmd_TestAbout: TBitBtn;
cmd_TestSplash: TBitBtn;
cmd_Close: TBitBtn;
CheckGroupShow: TCheckGroup;
edt_SplashHeight: TLabeledEdit;
edt_AboutHeight: TLabeledEdit;
edt_AboutWidth: TLabeledEdit;
CreditsGroupBox: TGroupBox;
FontDialog1: TFontDialog;
FontGroupBox: TGroupBox;
MainMenu1: TMainMenu;
mnu_helpAbout: TMenuItem;
mnu_fileHelp: TMenuItem;
mnu_fileClose: TMenuItem;
mnu_file: TMenuItem;
ResizeGraphicRadioGroup: TRadioGroup;
SetLicenseVarsGroupBox: TGroupBox;
GroupBoxBitmaps: TGroupBox;
GroupBoxTitleStyle: TGroupBox;
GroupBoxSplashDialog: TGroupBox;
edt_SplashWidth: TLabeledEdit;
GroupBoxAboutDialog: TGroupBox;
MaskTypeRadioGroup: TRadioGroup;
GraphicsRadioGroup: TRadioGroup;
dlg_OpenBitmap: TOpenPictureDialog;
LicenseFileRadioGroup: TRadioGroup;
txt_Top: TStaticText;
TitleStyleRadioGroup: TRadioGroup;
SplashAlignRadioGroup: TRadioGroup;
SplashAbout1: TSplashAbout;
AboutAlignRadioGroup: TRadioGroup;
procedure AboutAlignRadioGroupSelectionChanged(Sender: TObject);
procedure CheckGroupUseExternalFileClick(Sender: TObject);
procedure CheckGroupUseExternalFileItemClick(Sender: TObject; Index: integer);
procedure cmd_BitmapBackgroundClick(Sender: TObject);
procedure cmd_CreditsLinesClick(Sender: TObject);
procedure cmd_DescriptionClick(Sender: TObject);
procedure cmd_EditCreditsTxtClick(Sender: TObject);
procedure cmd_EditLicenseTxtClick(Sender: TObject);
procedure cmd_HelpClick(Sender: TObject);
procedure cmd_IconClick(Sender: TObject);
procedure cmd_BitmapMaskColorClick(Sender: TObject);
procedure cmd_BitmapMaskMonoClick(Sender: TObject);
procedure cmd_SetAuthorClick(Sender: TObject);
procedure cmd_SetFontClick(Sender: TObject);
procedure cmd_SetOrganisationClick(Sender: TObject);
procedure cmd_SetSupportContactClick(Sender: TObject);
procedure cmd_SetUserTitleClick(Sender: TObject);
procedure cmd_TestAboutClick(Sender: TObject);
procedure cmd_TestSplashClick(Sender: TObject);
procedure CheckGroupShowItemClick(Sender: TObject; Index: integer);
procedure edt_AboutHeightEditingDone(Sender: TObject);
procedure edt_AboutWidthEditingDone(Sender: TObject);
procedure edt_SplashHeightEditingDone(Sender: TObject);
procedure edt_SplashWidthEditingDone(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GraphicsRadioGroupSelectionChanged(Sender: TObject);
procedure LicenseFileRadioGroupSelectionChanged(Sender: TObject);
procedure MaskTypeRadioGroupSelectionChanged(Sender: TObject);
procedure mnu_helpAboutClick(Sender: TObject);
procedure ResizeGraphicRadioGroupSelectionChanged(Sender: TObject);
procedure SplashAlignRadioGroupSelectionChanged(Sender: TObject);
procedure TitleStyleRadioGroupSelectionChanged(Sender: TObject);
private
{ private declarations }
var
i: integer; //(Used in TryStrToInt routines)
sz: string; // used in InputQuery routines
ABitMap: TBitmap;
function FetchBitmap(const AFileFilter: string): boolean;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.cmd_TestAboutClick(Sender: TObject);
begin
SplashAbout1.ShowAbout;
end;
procedure TForm1.AboutAlignRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.FormAboutTextAlign := TAlignment(AboutAlignRadioGroup.ItemIndex);
end;
procedure TForm1.CheckGroupUseExternalFileClick(Sender: TObject);
begin
end;
procedure TForm1.CheckGroupUseExternalFileItemClick(Sender: TObject; Index: integer);
const
C_NOBITMAP = 'There is no graphic currently assigned. Click the button to assign one';
C_CLEAR_RESOURCE = 'Clear the graphic resource?';
// There's probably a more elegant way to do this...
begin
if (SplashAbout1.Graphics = saExternalFiles) then
// Set the ExternalFileOptions flags
begin
case Index of
0: if CheckGroupUseExternalFile.Checked[Index] then
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions + [saExternalBackground]
else
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions - [saExternalBackground];
1: if CheckGroupUseExternalFile.Checked[Index] then
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions + [saExternalMaskMonoImage]
else
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions - [saExternalMaskMonoImage];
2: if CheckGroupUseExternalFile.Checked[Index] then
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions + [saExternalMaskColorImage]
else
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions - [saExternalMaskColorImage];
3: if CheckGroupUseExternalFile.Checked[Index] then
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions + [saExternalIcon]
else
SplashAbout1.ExternalFileOptions :=
SplashAbout1.ExternalFileOptions - [saExternalIcon];
end;
end
else
begin
// Graphics=saResources so a different set of actions...
case Index of
0: if CheckGroupUseExternalFile.Checked[Index] then
begin
if (SplashAbout1.BitmapBackGround.Width = 0) then
begin
ShowMessage(C_NOBITMAP);
CheckGroupUseExternalFile.Checked[Index] := False;
end;
end
else
begin
if (SplashAbout1.BitmapBackGround.Width > 0) then
if MessageDlg(C_CLEAR_RESOURCE, mtConfirmation,
[mbYes, mbAbort], 0) = mrYes then
SplashAbout1.BitmapBackGround := nil
else
CheckGroupUseExternalFile.Checked[Index] := True;
end;
1: if CheckGroupUseExternalFile.Checked[Index] then
begin
if (SplashAbout1.BitmapMaskMono.Width = 0) then
begin
ShowMessage(C_NOBITMAP);
CheckGroupUseExternalFile.Checked[Index] := False;
end;
end
else
begin
if (SplashAbout1.BitmapMaskMono.Width > 0) then
if MessageDlg(C_CLEAR_RESOURCE, mtConfirmation,
[mbYes, mbAbort], 0) = mrYes then
SplashAbout1.BitmapMaskMono := nil
else
CheckGroupUseExternalFile.Checked[Index] := True;
end;
2: if CheckGroupUseExternalFile.Checked[Index] then
begin
if (SplashAbout1.BitmapMaskColor.Width = 0) then
begin
ShowMessage(C_NOBITMAP);
CheckGroupUseExternalFile.Checked[Index] := False;
end;
end
else
begin
if (SplashAbout1.BitmapMaskColor.Width > 0) then
if MessageDlg(C_CLEAR_RESOURCE, mtConfirmation,
[mbYes, mbAbort], 0) = mrYes then
SplashAbout1.BitmapMaskColor := nil
else
CheckGroupUseExternalFile.Checked[Index] := True;
end;
3: if CheckGroupUseExternalFile.Checked[Index]=False then
CheckGroupUseExternalFile.Checked[Index] := True;
end;
end;
end;
function TForm1.FetchBitmap(const AFileFilter: string): boolean;
// Open a graphics dialog with specified filter
// Use LoadFromFile to assign to a graphic type
// convert various graphic types into TBitmap and
// assign it to the private var ABitmap
// Used to assign to TBitmap properties of SplashAbout
var
MyBitMap: TBitMap;
MyJPG: TJpegImage;
MyTiff: TTiffImage;
MyGif: TGifImage;
MyPNG: TPortableNetworkGraphic;
szTemp: string;
begin
try
MyBitmap := TBitMap.Create;
MyJPG := TJpegImage.Create;
MyTiff := TTiffImage.Create;
// Turn off pointless compiler warning about creating a TGifImage
{$WARNINGS OFF}
MyGif := TGifImage.Create;
{$WARNINGS ON}
MyPNG := TPortableNetworkGraphic.Create;
szTemp := dlg_OpenBitmap.Filter;
Result := False;
dlg_OpenBitmap.Title := 'Fetch graphic';
dlg_OpenBitmap.Filter := 'Graphic|' + AFileFilter;
if dlg_OpenBitmap.Execute then
begin
if CompareFileExt(dlg_OpenBitmap.Filename, '.jpg', False) = 0 then
begin
MyJPG.LoadFromFile(dlg_OpenBitmap.Filename);
ABitMap.Assign(MyJPG);
end;
if CompareFileExt(dlg_OpenBitmap.Filename, '.bmp', False) = 0 then
begin
MyBitMap.LoadFromFile(dlg_OpenBitmap.Filename);
ABitMap.Assign(MyBitMap);
end;
if CompareFileExt(dlg_OpenBitmap.Filename, '.tif', False) = 0 then
begin
MyTiff.LoadFromFile(dlg_OpenBitmap.Filename);
ABitMap.Assign(MyTiff);
end;
if CompareFileExt(dlg_OpenBitmap.Filename, '.png', False) = 0 then
begin
MyPNG.LoadFromFile(dlg_OpenBitmap.Filename);
ABitMap.Assign(MyPNG);
end;
if CompareFileExt(dlg_OpenBitmap.Filename, '.gif', False) = 0 then
begin
MyGif.LoadFromFile(dlg_OpenBitmap.Filename);
ABitMap.Assign(MyGif);
end;
Result := True;
end;
finally
dlg_OpenBitmap.Filter := szTemp;
MyPNG.Free;
MyGif.Free;
MyTiff.Free;
MyJPG.Free;
MyBitmap.Free;
end;
end;
procedure TForm1.cmd_BitmapBackgroundClick(Sender: TObject);
begin
if (SplashAbout1.Graphics = saResources) then
begin
if FetchBitmap('*.bmp;*.jpg;*.tif;*.png;*.gif;') then
SplashAbout1.BitmapBackGround.Assign(ABitMap);
end
else
begin
dlg_OpenBitmap.Title := 'Fetch external graphic file';
dlg_OpenBitmap.Filename := SplashAbout1.ExternalFileBackgroundImage;
if dlg_OpenBitmap.Execute then
begin
SplashAbout1.ExternalFileBackgroundImage := dlg_OpenBitmap.Filename;
if (GraphicsRadioGroup.ItemIndex <> 0) then;
end;
end;
end;
procedure TForm1.cmd_CreditsLinesClick(Sender: TObject);
begin
with frm_StringListEditor do
begin
Caption := 'Edit CreditLines';
StringListEditorMemo.Clear;
StringListEditorMemo.Lines.Assign(SplashAbout1.Creditlines);
ShowModal;
SplashAbout1.Creditlines.Assign(StringListEditorMemo.Lines);
end;
end;
procedure TForm1.cmd_DescriptionClick(Sender: TObject);
begin
with frm_StringListEditor do
begin
Caption := 'Edit Description';
StringListEditorMemo.Clear;
StringListEditorMemo.Lines.Assign(SplashAbout1.Description);
ShowModal;
SplashAbout1.Description.Assign(StringListEditorMemo.Lines);
end;
end;
procedure TForm1.cmd_EditCreditsTxtClick(Sender: TObject);
begin
// Warn user
if (not FileExists(SplashAbout1.CreditsTextFilename)) then
ShowMessageFmt(
'Note that if you create and populate ''%s'' it will be used in preference to the CreditLines stringlist',
[SplashAbout1.CreditsTextFilename]);
with frm_StringListEditor do
begin
StringListEditorMemo.Clear;
// Load from file?
if FileExists(SplashAbout1.CreditsTextFilename) then
StringListEditorMemo.Lines.LoadFromFile(SplashAbout1.CreditsTextFilename);
// Show the editor
ShowModal;
// Only (create) and Save if there is text in the Memo
// Note this overwrites any existing file
if StringListEditorMemo.Lines.Count > 0 then
StringListEditorMemo.Lines.SaveToFile(SplashAbout1.CreditsTextFilename)
else
// Clearing the text and saving deletes any existing file
// No point in saving an empty file
if FileExists(SplashAbout1.CreditsTextFilename) then
SysUtils.DeleteFile(SplashAbout1.CreditsTextFilename);
end;
end;
procedure TForm1.cmd_EditLicenseTxtClick(Sender: TObject);
begin
with frm_StringListEditor do
begin
StringListEditorMemo.Clear;
if FileExists('license.txt') then
StringListEditorMemo.Lines.LoadFromFile('license.txt');
ShowModal;
if StringListEditorMemo.Lines.Count > 0 then
StringListEditorMemo.Lines.SaveToFile('license.txt')
else
begin
if FileExists('license.txt') then
begin
FileUtil.CopyFile('license.txt', 'license.txt.bak');
DeleteFile('license.txt');
ShowMessage('Old ''license.txt'' has been backed up to ''license.txt.bak''');
end;
end;
end;
end;
procedure TForm1.cmd_HelpClick(Sender: TObject);
var
iPos: integer;
begin
with frm_StringListEditor do
begin
Caption := 'Help for SplashAbout tester';
StringListEditorMemo.Clear;
StringListEditorMemo.Lines.LoadFromFile('readme.txt');
// Highlight the relavent text
iPos := Pos('==If', StringListEditorMemo.Text);
StringListEditorMemo.SelStart := iPos - 1;
StringListEditorMemo.SelLength := 98;
// Show the readonly memo
StringListEditorMemo.ReadOnly := True;
ShowModal;
StringListEditorMemo.ReadOnly := False;
end;
end;
procedure TForm1.cmd_IconClick(Sender: TObject);
var
szTemp: string;
begin
Try
if (SplashAbout1.Graphics = saResources) then
begin
szTemp := dlg_OpenBitmap.Filter;
dlg_OpenBitmap.Filter := 'Icon|*.ico';
if dlg_OpenBitmap.Execute then
begin
SplashAbout1.Icon.LoadFromFile(dlg_OpenBitmap.Filename);
end;
dlg_OpenBitmap.Filter := szTemp;
end
else
begin
dlg_OpenBitmap.Filename := SplashAbout1.ExternalFileIcon;
if dlg_OpenBitmap.Execute then
begin
SplashAbout1.ExternalFileIcon := dlg_OpenBitmap.Filename;
if (GraphicsRadioGroup.ItemIndex <> 0) then
begin
GraphicsRadioGroup.ItemIndex := 0;
ShowMessage('Graphics property has been set to saExternalFiles');
end;
end;
end;
Except
on e: Exception do
ShowMessage(e.ClassName);
end;
end;
procedure TForm1.cmd_BitmapMaskColorClick(Sender: TObject);
begin
if (SplashAbout1.Graphics = saResources) then
begin
if FetchBitmap('*.bmp;*.jpg;*.tif;*.png;*.gif;') then
SplashAbout1.BitmapMaskColor.Assign(ABitMap);
end
else
begin
dlg_OpenBitmap.Filename := SplashAbout1.ExternalFileMaskColorImage;
if dlg_OpenBitmap.Execute then
begin
SplashAbout1.ExternalFileMaskColorImage := dlg_OpenBitmap.Filename;
if (GraphicsRadioGroup.ItemIndex <> 0) then
begin
GraphicsRadioGroup.ItemIndex := 0;
ShowMessage('Graphics property has been set to saExternalFiles');
end;
end;
end;
end;
procedure TForm1.cmd_BitmapMaskMonoClick(Sender: TObject);
begin
if (SplashAbout1.Graphics = saResources) then
begin
if FetchBitmap('*.bmp;') then
SplashAbout1.BitmapMaskMono.Assign(ABitMap);
end
else
begin
dlg_OpenBitmap.Filename := SplashAbout1.ExternalFileMaskMonoImage;
if dlg_OpenBitmap.Execute then
begin
SplashAbout1.ExternalFileMaskMonoImage := dlg_OpenBitmap.Filename;
if (GraphicsRadioGroup.ItemIndex <> 0) then
begin
GraphicsRadioGroup.ItemIndex := 0;
ShowMessage('Graphics property has been set to saExternalFiles');
end;
end;
end;
end;
procedure TForm1.cmd_SetAuthorClick(Sender: TObject);
begin
if InputQuery('Set the Author token', 'Current value = ' +
SplashAbout1.Author, sz) then
SplashAbout1.Author := sz;
end;
procedure TForm1.cmd_SetFontClick(Sender: TObject);
begin
{$IFDEF WINDOWS}
// Warning: 'THandle is depreciated'
{$WARNINGS OFF}
FontDialog1.Font.Name := GetFontData(cmd_SetFont.Font.Handle).Name;
{$WARNINGS ON}
{$ENDIF}
if FontDialog1.Execute then
SplashAbout1.Font.Assign(FontDialog1.Font);
end;
procedure TForm1.cmd_SetOrganisationClick(Sender: TObject);
begin
if InputQuery('Set the Organisation token', 'Current value = ' +
SplashAbout1.Organisation, sz) then
SplashAbout1.Organisation := sz;
end;
procedure TForm1.cmd_SetSupportContactClick(Sender: TObject);
begin
if InputQuery('Set the SupportContact token', 'Current value = ' +
SplashAbout1.SupportContact, sz) then
SplashAbout1.SupportContact := sz;
end;
procedure TForm1.cmd_SetUserTitleClick(Sender: TObject);
begin
if InputQuery('Set the User Title', 'Current value = ' +
SplashAbout1.UserTitle, sz) then
SplashAbout1.UserTitle := sz;
end;
procedure TForm1.cmd_TestSplashClick(Sender: TObject);
begin
SplashAbout1.ShowSplash;
end;
procedure TForm1.CheckGroupShowItemClick(Sender: TObject; Index: integer);
begin
with CheckGroupShow do
case Index of
0: SplashAbout1.ShowPoweredBy := Checked[0];
1: SplashAbout1.ShowDescription := Checked[1];
2: SplashAbout1.ShowCreditButton := Checked[2];
end;
end;
procedure TForm1.edt_AboutHeightEditingDone(Sender: TObject);
begin
if TryStrToInt(edt_AboutHeight.Text, i) then
SplashAbout1.FormAboutHeight := i
else
begin
ShowMessageFmt('%s is not a number', [edt_AboutHeight.Text]);
edt_AboutHeight.Text := IntToStr(SplashAbout1.FormAboutHeight);
end;
end;
procedure TForm1.edt_AboutWidthEditingDone(Sender: TObject);
begin
if TryStrToInt(edt_AboutWidth.Text, i) then
SplashAbout1.FormAboutWidth := i
else
begin
ShowMessageFmt('%s is not a number', [edt_AboutWidth.Text]);
edt_AboutWidth.Text := IntToStr(SplashAbout1.FormAboutWidth);
end;
end;
procedure TForm1.edt_SplashHeightEditingDone(Sender: TObject);
begin
if TryStrToInt(edt_SplashHeight.Text, i) then
SplashAbout1.FormSplashHeight := i
else
begin
ShowMessageFmt('%s is not a number', [edt_SplashHeight.Text]);
edt_SplashHeight.Text := IntToStr(SplashAbout1.FormSplashHeight);
end;
end;
procedure TForm1.edt_SplashWidthEditingDone(Sender: TObject);
begin
if TryStrToInt(edt_SplashWidth.Text, i) then
SplashAbout1.FormSplashWidth := i
else
begin
ShowMessageFmt('%s is not a number', [edt_SplashWidth.Text]);
edt_SplashWidth.Text := IntToStr(SplashAbout1.FormSplashWidth);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SplashAbout1.ShowSplash;
// Init the Example app controls
// RadioGroups (enumerated properties)
MaskTypeRadioGroup.ItemIndex := Ord(SplashAbout1.MaskType);
TitleStyleRadioGroup.ItemIndex := Ord(SplashAbout1.TitleStyle);
SplashAlignRadioGroup.ItemIndex := Ord(SplashAbout1.FormSplashTextAlign);
AboutAlignRadioGroup.ItemIndex := Ord(SplashAbout1.FormAboutTextAlign);
LicenseFileRadioGroup.ItemIndex := Ord(SplashAbout1.LicenseFile);
ResizeGraphicRadioGroup.ItemIndex := Ord(SplashAbout1.ResizeMode);
// Enumerated type with 2 items acts like booleans (!)
if SplashAbout1.Graphics = saExternalFiles then
GraphicsRadioGroup.ItemIndex := 0
else
GraphicsRadioGroup.ItemIndex := 1;
with CheckGroupShow do
// Checkboxes
begin
if SplashAbout1.ShowPoweredBy then
Checked[0] := True;
if SplashAbout1.ShowDescription then
Checked[1] := True;
if SplashAbout1.ShowCreditButton then
Checked[2] := True;
end;
with CheckGroupUseExternalFile do
begin
if saExternalBackground in SplashAbout1.ExternalFileOptions then
Checked[0] := True;
if saExternalMaskMonoImage in SplashAbout1.ExternalFileOptions then
Checked[1] := True;
if saExternalMaskColorImage in SplashAbout1.ExternalFileOptions then
Checked[2] := True;
if saExternalIcon in SplashAbout1.ExternalFileOptions then
Checked[3] := True;
end;
// Edit controls
edt_SplashWidth.Text := IntToStr(SplashAbout1.FormSplashWidth);
edt_SplashHeight.Text := IntToStr(SplashAbout1.FormSplashHeight);
edt_AboutWidth.Text := IntToStr(SplashAbout1.FormAboutWidth);
edt_AboutHeight.Text := IntToStr(SplashAbout1.FormAboutHeight);
// Buttons
cmd_EditCreditsTxt.Caption := 'Edit ' + SplashAbout1.CreditsTextfileName;
ABitmap := TBitmap.Create;
end;
procedure TForm1.GraphicsRadioGroupSelectionChanged(Sender: TObject);
Var iCount:Integer;
begin
case GraphicsRadioGroup.ItemIndex of
0: SplashAbout1.Graphics := saExternalFiles;
1: SplashAbout1.Graphics := saResources;
end;
// Reset the 'Use' checkboxes
For iCount:=0 to 3 do
CheckGroupUseExternalFile.Checked[iCount]:=True;
end;
procedure TForm1.LicenseFileRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.LicenseFile := tLicenseFile(LicenseFileRadioGroup.ItemIndex);
end;
procedure TForm1.MaskTypeRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.MaskType := tMaskType(MaskTypeRadioGroup.ItemIndex);
end;
procedure TForm1.mnu_helpAboutClick(Sender: TObject);
// You can set Splashabout properties via code:
Var
tempTitleStyle:TTitleStyleType;
tempTitle:String;
begin
With SplashAbout1 do
begin
tempTitleStyle:=TitleStyle;
tempTitle:=UserTitle;
TitleStyle:=saUserTitle;
UserTitle:=txt_Top.Caption;
ShowAbout;
TitleStyle:=tempTitleStyle;
UserTitle:=tempTitle;
end;
end;
procedure TForm1.ResizeGraphicRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.ResizeMode:=tResizeMode(ResizeGraphicRadioGroup.ItemIndex);
end;
procedure TForm1.SplashAlignRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.FormSplashTextAlign := TAlignment(SplashAlignRadioGroup.ItemIndex);
end;
procedure TForm1.TitleStyleRadioGroupSelectionChanged(Sender: TObject);
begin
SplashAbout1.TitleStyle := TTitleStyleType(TitleStyleRadioGroup.ItemIndex);
end;
// When compiling, explain the 'platform' directive on some properties
{$Hint Don't worry about the 'Warning: Symbol xxx is not portable' messages}
{$Hint The 'not portable' code is stuff that won't work outside of Windows}
{$Hint ..so I flagged it as such in the component code}
end.

47
splashabout_component/exampleapp/ustringlisteditor.lfm Normal file
View File

@@ -0,0 +1,47 @@
object frm_StringListEditor: Tfrm_StringListEditor
Left = 1028
Height = 513
Top = 327
Width = 552
BorderIcons = []
BorderStyle = bsSizeToolWin
Caption = 'frm_StringListEditor'
ClientHeight = 513
ClientWidth = 552
DefaultMonitor = dmMainForm
FormStyle = fsStayOnTop
PopupMode = pmExplicit
PopupParent = Form1.Owner
Position = poMainFormCenter
ShowInTaskBar = stNever
LCLVersion = '1.2.2.0'
object StringListEditorMemo: TMemo
Left = 0
Height = 440
Top = 0
Width = 552
Align = alTop
ScrollBars = ssAutoVertical
TabOrder = 0
end
object cmd_Close: TBitBtn
Left = 219
Height = 30
Top = 464
Width = 115
Caption = '&Close and Save'
Kind = bkClose
ModalResult = 11
TabOrder = 1
end
object cmd_ClearMemo: TBitBtn
Left = 424
Height = 30
Top = 464
Width = 107
Caption = 'Clear all text'
Kind = bkAbort
OnClick = cmd_ClearMemoClick
TabOrder = 2
end
end

40
splashabout_component/exampleapp/ustringlisteditor.pas Normal file
View File

@@ -0,0 +1,40 @@
unit uStringListEditor;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Buttons;
type
{ Tfrm_StringListEditor }
Tfrm_StringListEditor = class(TForm)
cmd_ClearMemo: TBitBtn;
cmd_Close: TBitBtn;
StringListEditorMemo: TMemo;
procedure cmd_ClearMemoClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
frm_StringListEditor: Tfrm_StringListEditor;
implementation
{$R *.lfm}
{ Tfrm_StringListEditor }
procedure Tfrm_StringListEditor.cmd_ClearMemoClick(Sender: TObject);
begin
StringListEditorMemo.Clear;
end;
end.