pascal/lina-components
1
0
Fork 0
mirror of https://bitbucket.org/Dennis07/lina-components.git synced 2025-02-02 10:25:22 +02:00
Code Issues Actions Releases Activity

Version 1.0 DEV 1.11

Browse Source 
Signed-off-by: Dennis07 <den.goehlert@t-online.de>
This commit is contained in:
Dennis07 2014-10-08 02:09:31 +02:00
parent 15d0b479d2
commit 1c2743e97b
36 changed files with 897 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
Example/TParamDefiner/pExample.exe
View File

Binary file not shown.

BIN
Example/TParamDefiner/pExample.identcache
View File

Binary file not shown.

2
Example/TParamDefiner/uMain.dfm
View File

@ -79,7 +79,7 @@ object fmMain: TfmMain
Height = 21
EditLabel.Width = 52
EditLabel.Height = 13
EditLabel.Caption = 'Seperator:'
EditLabel.Caption = 'Separator:'
TabOrder = 2
OnChange = leSeparatorChange
end

71
Example/TParamDefiner/uMain.pas
View File

@ -63,7 +63,7 @@ begin
Identifier := IdentList.Strings[Index];
Connector := @Params[Index + 100];
Format.Prefix := lePrefix.Text;
Format.Seperator := leSeparator.Text;
Format.Separator := leSeparator.Text;
Format.Suffix := leSuffix.Text;
end;
end;
@ -120,6 +120,9 @@ begin
end;
function TfmMain.GenerateParamsString: String;
{ Diese Funktion dient nur der Veranschaulichung und sollte an eigenen Projekten
nicht verwendet werden. Stattdessen sollten Funktionen wie "StringFromParams"
aus der "uFrmCtrls"-Unit verwendet werden. }
var
IdentList: TStrings;
ValueList: TStrings;
@ -155,45 +158,81 @@ end;
procedure TfmMain.lePrefixChange(Sender: TObject);
var
Index: Integer;
TempStr: TCaption;
OldIndex: Integer;
begin
try
for Index := 0 to ParamDefiner.References.Count - 1 do
TempStr := '';
for Index := 1 to Length(lePrefix.Text) do
begin
if not (lePrefix.Text[Index] in [#34,#39]) then
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Prefix := lePrefix.Text;
TempStr := TempStr + lePrefix.Text[Index];
end;
except
end;
if TempStr <> lePrefix.Text then
begin
OldIndex := lePrefix.SelStart;
lePrefix.Text := TempStr;
lePrefix.SelStart := OldIndex;
Beep;
lePrefix.Text := '[';
end;
for Index := 0 to ParamDefiner.References.Count - 1 do
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Prefix := lePrefix.Text;
end;
end;
procedure TfmMain.leSeparatorChange(Sender: TObject);
var
Index: Integer;
TempStr: TCaption;
OldIndex: Integer;
begin
try
for Index := 0 to ParamDefiner.References.Count - 1 do
TempStr := '';
for Index := 1 to Length(leSeparator.Text) do
begin
if not (leSeparator.Text[Index] in [#34,#39]) then
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Seperator := leSeparator.Text;
TempStr := TempStr + leSeparator.Text[Index];
end;
except
end;
if TempStr <> leSeparator.Text then
begin
OldIndex := leSeparator.SelStart;
leSeparator.Text := TempStr;
leSeparator.SelStart := OldIndex;
Beep;
lePrefix.Text := ':';
end;
for Index := 0 to ParamDefiner.References.Count - 1 do
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Separator := leSeparator.Text;
end;
end;
procedure TfmMain.leSuffixChange(Sender: TObject);
var
Index: Integer;
TempStr: TCaption;
OldIndex: Integer;
begin
try
for Index := 0 to ParamDefiner.References.Count - 1 do
TempStr := '';
for Index := 1 to Length(leSuffix.Text) do
begin
if not (leSuffix.Text[Index] in [#34,#39]) then
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Suffix := leSuffix.Text;
TempStr := TempStr + leSuffix.Text[Index];
end;
except
end;
if TempStr <> leSuffix.Text then
begin
OldIndex := leSuffix.SelStart;
leSuffix.Text := TempStr;
leSuffix.SelStart := OldIndex;
Beep;
lePrefix.Text := ']';
end;
for Index := 0 to ParamDefiner.References.Count - 1 do
begin
(ParamDefiner.References.Items[Index] as TParamReference).Format.Suffix := leSuffix.Text;
end;
end;

BIN
Information/Analytics/SM-LINA-10.smproj
View File

Binary file not shown.

4
Information/Statistics.txt
View File

@ -1,4 +1,4 @@
These statistics cover the official repository of Lina Components.
Total lines of code (LoC): 5500+
Total visual components (VC): 14
Total lines of code (LoC): 6300+
Total visual components (VC): 15

1
Package/Delphi_XE5/LINA_D_XE5.dpk
View File

@ -3,6 +3,7 @@ package LINA_D_XE5;
{$R *.res}
{$R '..\..\Resource\Compiled\uAdvCtrls.dcr'}
{$R '..\..\Resource\Compiled\uSysCtrls.dcr'}
{$R '..\..\Resource\Compiled\uFileCtrls.dcr'}
{$R '..\..\Resource\Compiled\uFrmCtrls.dcr'}
{$R '..\..\Resource\Compiled\uLocalMgr.dcr'}
{$R '..\..\Resource\Compiled\uScriptMgr.dcr'}

2
Package/Delphi_XE5/LINA_D_XE5.dproj
View File

@ -83,6 +83,7 @@
<DCC_RemoteDebug>true</DCC_RemoteDebug>
</PropertyGroup>
<PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
<DCC_AdditionalSwitches>-LUDesignIDE</DCC_AdditionalSwitches>
<DCC_DcuOutput>..\..\Source\Compiled\</DCC_DcuOutput>
<VerInfo_Keys>CompanyName=Dennis Göhlert a.o.;FileDescription=Lina Components;FileVersion=1.0.0.0;InternalName=;LegalCopyright=2014;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=</VerInfo_Keys>
<VerInfo_Locale>1033</VerInfo_Locale>
@ -102,6 +103,7 @@
</DelphiCompile>
<DCCReference Include="..\..\Resource\Compiled\uAdvCtrls.dcr"/>
<DCCReference Include="..\..\Resource\Compiled\uSysCtrls.dcr"/>
<DCCReference Include="..\..\Resource\Compiled\uFileCtrls.dcr"/>
<DCCReference Include="..\..\Resource\Compiled\uFrmCtrls.dcr"/>
<DCCReference Include="..\..\Resource\Compiled\uLocalMgr.dcr"/>
<DCCReference Include="..\..\Resource\Compiled\uScriptMgr.dcr"/>

57
Package/Delphi_XE5/LINA_D_XE5.dproj.local
View File

@ -1,46 +1,46 @@
<?xml version="1.0" encoding="utf-8"?>
<BorlandProject>
<Transactions>
<Transaction>1899.12.30 00:00:00.000.204,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\uFileCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFileCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.325,=dbrtl.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.508,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBase.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.650,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.576,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysTools.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.791,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.675,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.681,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc=</Transaction>
<Transaction>1899.12.30 00:00:00.000.592,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uFileTools.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.809,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc</Transaction>
<Transaction>1899.12.30 00:00:00.000.621,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.318,=vcl.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.414,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas=</Transaction>
<Transaction>1899.12.30 00:00:00.000.577,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBattery.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.556,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uLocalMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.508,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBase.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.650,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.648,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uScriptMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.518,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.537,C:\Users\Dennis G\Documents\CodeQuality.htm=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Untitled1.htm</Transaction>
<Transaction>1899.12.30 00:00:00.000.681,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc=</Transaction>
<Transaction>1899.12.30 00:00:00.000.325,=dbrtl.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.809,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc</Transaction>
<Transaction>1899.12.30 00:00:00.000.932,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\uFileCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.592,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uFileTools.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.537,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Untitled1.htm=C:\Users\Dennis G\Documents\CodeQuality.htm</Transaction>
<Transaction>1899.12.30 00:00:00.000.414,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas=</Transaction>
<Transaction>1899.12.30 00:00:00.000.143,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Untitled1.htm</Transaction>
<Transaction>1899.12.30 00:00:00.000.633,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\LINA_D_XE5.dproj=C:\Users\Dennis\Documents\RAD Studio\Projekte\Package1.dproj</Transaction>
<Transaction>1899.12.30 00:00:00.000.577,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBattery.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.318,=vcl.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.896,C:\Users\Dennis G\Documents\CodeQuality.htm=</Transaction>
<Transaction>1899.12.30 00:00:00.000.837,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.971,=IndySystem.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.556,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uLocalMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.621,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.204,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFileCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\uFileCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.412,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.196,=rtl.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.555,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBase.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.686,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uSysTools.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.971,=IndySystem.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.584,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uVirtObj.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.555,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBase.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.118,=IndyCore.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.535,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFileTools.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.633,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLocalMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.525,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCrypt.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.582,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uWebCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.672,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uFrmCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.932,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\uFileCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.566,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uScriptMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.412,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.411,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uAdvCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.582,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uWebCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.045,=IndyProtocols.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.633,C:\Users\Dennis\Documents\RAD Studio\Projekte\Package1.dproj=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\LINA_D_XE5.dproj</Transaction>
<Transaction>1899.12.30 00:00:00.000.857,=PascalScript_Core_D19.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.633,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLocalMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.546,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFrmCtrls.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.411,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uAdvCtrls.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.791,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.837,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.675,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.045,=IndyProtocols.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.525,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCrypt.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.857,=PascalScript_Core_D19.dcp</Transaction>
<Transaction>1899.12.30 00:00:00.000.566,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uScriptMgr.pas</Transaction>
<Transaction>1899.12.30 00:00:00.000.799,=PascalScript_Core_D19.dcp</Transaction>
</Transactions>
<ProjectSortOrder AutoSort="0" SortType="0">
@ -48,6 +48,7 @@
<File Path="..\..\Resource"/>
<File Path="..\..\Resource\Compiled"/>
<File Path="..\..\Resource\Compiled\uAdvCtrls.dcr"/>
<File Path="..\..\Resource\Compiled\uFileCtrls.dcr"/>
<File Path="..\..\Resource\Compiled\uFrmCtrls.dcr"/>
<File Path="..\..\Resource\Compiled\uLocalMgr.dcr"/>
<File Path="..\..\Resource\Compiled\uScriptMgr.dcr"/>

BIN
Package/Delphi_XE5/LINA_D_XE5.identcache
View File

Binary file not shown.

BIN
Resource/Bitmap/Large/TContextMenu.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 2.1 KiB

BIN
Resource/Bitmap/Small/TContextMenu.bmp Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 1.3 KiB

BIN
Resource/Bitmap/TPaintMemo.bmp
View File

Binary file not shown.
Side by Side Swipe Overlay

Before

Width:  |  Height:  |  Size: 1.6 KiB

After

Width:  |  Height:  |  Size: 1.6 KiB

BIN
Resource/Compiled/uAdvCtrls.dcr
View File

Binary file not shown.

BIN
Resource/Compiled/uFileCtrls.dcr Normal file
View File

Binary file not shown.

3
Resource/LINA.rc
View File

@ -7,6 +7,9 @@ TCOMMANDBUTTON32 BITMAP "Bitmap\Large\TCommandButton.bmp"
TCOMPONENTMANAGER BITMAP "Bitmap\TComponentManager.bmp"
TCOMPONENTMANAGER16 BITMAP "Bitmap\Small\TComponentManager.bmp"
TCOMPONENTMANAGER32 BITMAP "Bitmap\Large\TComponentManager.bmp"
TCONTEXTMENU BITMAP "Bitmap\TContextMenu.bmp"
TCONTEXTMENU16 BITMAP "Bitmap\Small\TContextMenu.bmp"
TCONTEXTMENU32 BITMAP "Bitmap\Large\TContextMenu.bmp"
TCURSORFIX BITMAP "Bitmap\TCursorFix.bmp"
TCURSORFIX16 BITMAP "Bitmap\Small\TCursorFix.bmp"
TCURSORFIX32 BITMAP "Bitmap\Large\TCursorFix.bmp"

BIN
Source/Compiled/uAdvCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uBase.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uCrypt.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFileCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFileTools.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uFrmCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uLocalMgr.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uScriptMgr.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uSysCtrls.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uSysTools.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uVirtObj.dcu
View File

Binary file not shown.

BIN
Source/Compiled/uWebCtrls.dcu
View File

Binary file not shown.

18
Source/uAdvCtrls.pas
View File

@ -100,7 +100,9 @@ type
property CaptionPosition: TPoint read FCaptionPosition write FCaptionPosition;
end;
procedure Register;
procedure Register;
function BmpToIco(Bitmap: TBitmap): TIcon;
const
{ Meta-Daten }
@ -132,6 +134,20 @@ begin
RegisterComponents(ComponentsPage,[TCommandButton,TScrollListBox,TPaintMemo]);
end;
function BmpToIco(Bitmap: TBitmap): TIcon;
begin
with TImageList.CreateSize(Bitmap.Width,Bitmap.Height) do
begin
try
AddMasked(Bitmap,Bitmap.TransparentColor);
Result := TIcon.Create;
GetIcon(0,Result);
finally
Free;
end;
end;
end;
{ ----------------------------------------------------------------------------
TAdvancedButton
---------------------------------------------------------------------------- }

9
Source/uBase.pas
View File

@ -32,6 +32,15 @@ unit uBase;
vermeiden. }
{$DEFINE NO_GENERIC}
{$IFEND}
{$IF CompilerVersion < 20.0}
{ Unter früheren Delphi-Versionen als 2009 entsprach der String-Typenalias
dem AnsiString-Typen. Da es gegebenfalls bei manchen externen (zB. OS-
Spezifischen) Klassen zu Kompatibilitätsproblemen kommmen könnte, wird
hier eine Überprüfung der Unicode-Unterstützung durchgeführt.
Zu beachten ist jedoch, dass Delphi 2009 und höher AnsiStrings implizit
in UnicodeStrings umwandelt und umgekehrt (sofern möglich). }
{$DEFINE NO_UNICODE}
{$IFEND}
interface

352
Source/uFileCtrls.pas
View File

@ -6,48 +6,370 @@ unit uFileCtrls;
/// (c) 2014 Dennis Göhlert a.o. ///
//////////////////////////////////////
{$IFNDEF MSWINDOWS}
{$MESSAGE ERROR 'The "uFileCtrls" unit is only available under MS-Windows OS'}
{$ENDIF}
interface
uses
{ Standard-Units }
SysUtils, Classes, ComCtrls, Menus,
SysUtils, Classes, Windows, Registry,
{ Andere Package-Units }
uBase, uFileTools;
uBase;
type
{ Fehlermeldungen }
EInvalidItemName = class(Exception);
EInvalidExt = class(Exception);
EInvalidAlias = class(Exception);
type
{ Hauptklassen }
TDirPopupMenu = class(TPopupMenu)
end;
TDirListView = class(TListView)
TContextMenuItem = class(TCollectionItem)
private
{ Private-Deklarationen }
FName: TComponentName;
FCaption: ShortString;
FCommand: AnsiString;
FIcon: TFileName;
{ Methden }
procedure SetName(Value: TComponentName);
procedure SetIcon(Value: TFileName);
public
{ Public-Deklarationen }
constructor Create(Collextion: TCollection); override;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Name: TComponentName read FName write SetName;
property Caption: ShortString read FCaption write FCaption;
property Command: AnsiString read FCommand write FCommand;
property Icon: TFileName read FIcon write SetIcon;
end;
TContextMenuItems = class(TCollection);
TContextMenu = class(TComponent)
private
{ Private-Deklarationen }
PopupMenu: TPopupMenu;
FAbout: TComponentAbout;
FFiles: TWinFileArray;
FItems: TContextMenuItems;
FExt: ShortString;
FAutoLoad: Boolean;
FAlias: ShortString;
{ Methoden }
procedure SetExt(Value: ShortString);
procedure SetAutoLoad(Value: Boolean);
procedure SetAlias(Value: ShortString);
protected
{ Protected-Deklarationen }
procedure CreateMenuItem(const AName: TComponentName;
const ACaption: ShortString; const ACommand: AnsiString;
const AIcon: TFileName);
procedure CreateRegistryEntry(var ARegistry: TRegistry;
const AName: TComponentName; const ACaption: ShortString;
const ACommand: AnsiString; const AIcon: TFileName);
public
{ Public-Deklarationen }
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure LoadFromRegistry;
procedure SaveToRegistry;
published
{ Published-Deklarationen }
property About: TComponentAbout read FAbout;
// property Files[Index: Integer]: TWinFile read FFiles;
property Items: TContextMenuItems read FItems write FItems;
property Ext: ShortString read FExt write SetExt;
property AutoLoad: Boolean read FAutoLoad write SetAutoLoad default False;
property Alias: ShortString read FAlias write SetAlias;
end;
procedure Register;
function ExtStrToRegKey(ExtStr: String): String;
const
{ Meta-Daten }
ContextMenuComponent_Name = 'ContextMenu';
ContextMenuComponent_Version = 1.0;
ContextMenuComponent_Copyright = 'Copyright © 2014';
ContextMenuComponent_Author = 'Dennis Göhlert a.o.';
{ Sonstige }
ContextRegPathShell = '\shell';
ContextRegPathCommand = '\command';
implementation
constructor TDirListView.Create(AOwner: TComponent);
procedure Register;
begin
inherited;
PopupMenu := TPopupMenu.Create(Self);
RegisterComponents(ComponentsPage,[TContextMenu]);
end;
destructor TDirListView.Destroy;
function ExtStrToRegKey(ExtStr: String): String;
begin
if ExtStr = '*' then
begin
Result := ExtStr;
end else
begin
Result := '.' + ExtStr;
end;
end;
{ ----------------------------------------------------------------------------
TContextMenuItem
---------------------------------------------------------------------------- }
constructor TContextMenuItem.Create(Collextion: TCollection);
begin
PopupMenu.Free;
inherited;
FName := ClassName + IntToStr(ID);
end;
destructor TContextMenuItem.Destroy;
begin
//...
inherited;
end;
procedure TContextMenuItem.SetName(Value: TComponentName);
var
Index: Integer;
begin
if Length(Value) = 0 then
begin
raise EInvalidItemName.Create('Invalid context menu item name');
end;
for Index := 1 to Length(Value) do
begin
if Value[Index] = PathDelim then
begin
raise EInvalidItemName.Create('Invalid contect menu item name');
end;
end;
FName := Value;
end;
procedure TContextMenuItem.SetIcon(Value: TFileName);
begin
if (FileExists(Value) = True) then
begin
FIcon := Value;
end else
begin
raise EFileNotFoundException.Create('Icon file not found: "' + Value + '"');
end;
end;
{ ----------------------------------------------------------------------------
TContextMenu
---------------------------------------------------------------------------- }
constructor TContextMenu.Create(AOwner: TComponent);
begin
inherited;
FAbout := TComponentAbout.Create(ContextMenuComponent_Name,ContextMenuComponent_Version,ContextMenuComponent_Copyright,ContextMenuComponent_Author);
FItems := TContextMenuItems.Create(TContextMenuItem);
FExt := '*';
FAutoLoad := False;
end;
destructor TContextMenu.Destroy;
begin
FAbout.Free;
FItems.Free;
inherited;
end;
procedure TContextMenu.SetExt(Value: ShortString);
var
Index: Integer;
begin
if Value = FExt then
begin
Exit;
end;
if Length(Value) > 0 then
begin
if Value <> '*' then
begin
for Index := 1 to Length(Value) do
begin
if not (Value[Index] in ['0'..'9','A'..'Z','a'..'z']) then
begin
raise EInvalidExt.Create('Invalid file extension value');
end;
end;
end;
FExt := Value;
end else
begin
FExt := '*';
end;
if FAutoLoad = True then
begin
LoadFromRegistry;
end;
end;
procedure TContextMenu.SetAutoLoad(Value: Boolean);
begin
FAutoLoad := Value;
if Value = True then
begin
LoadFromRegistry;
end;
end;
procedure TContextMenu.SetAlias(Value: ShortString);
var
Index: Integer;
begin
if Value = FExt then
begin
Exit;
end;
if Length(Value) > 0 then
begin
for Index := 1 to Length(Value) do
begin
if not (Value[Index] in ['0'..'9','A'..'Z','a'..'z']) then
begin
raise EInvalidAlias.Create('Invalid extension alias value');
end;
end;
end;
FAlias := Value;
end;
procedure TContextMenu.CreateMenuItem(const AName: TComponentName;
const ACaption: ShortString; const ACommand: AnsiString;
const AIcon: TFileName);
begin
with (Items.Add as TContextMenuItem) do
begin
Name := AName;
Caption := ACaption;
Command := ACommand;
Icon := AIcon;
end;
end;
procedure TContextMenu.CreateRegistryEntry(var ARegistry: TRegistry;
const AName: TComponentName; const ACaption: ShortString;
const ACommand: AnsiString; const AIcon: TFileName);
var
Key: String;
begin
Key := ExtStrToRegKey(Ext) + ContextRegPathShell;
with ARegistry do
begin
OpenKey(Key + '\' + AName,True);
WriteString('',ACaption);
WriteString('icon',AIcon);
CloseKey;
OpenKey(Key + '\' + AName + ContextRegPathCommand,True);
WriteString('',ACommand);
CloseKey;
end;
end;
procedure TContextMenu.LoadFromRegistry;
var
Reg: TRegistry;
Key: String;
SubKeys: TStrings;
Index: Integer;
Cptn: ShortString;
Cmd: AnsiString;
Icn: TFileName;
begin
Items.Clear;
Reg := TRegistry.Create;
SubKeys := TStringList.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.Access := KEY_READ;
if Reg.KeyExists(ExtStrToRegKey(Ext)) = True then
begin
Reg.OpenKeyReadOnly(ExtStrToRegKey(Ext));
if Reg.ValueExists('') = True then
begin
FAlias := Reg.ReadString('');
end;
Reg.CloseKey;
end;
Key := ExtStrToRegKey(Ext) + ContextRegPathShell;
if Reg.KeyExists(Key) = True then
begin
Reg.OpenKeyReadOnly(Key);
if Reg.HasSubKeys = True then
begin
Reg.GetKeyNames(SubKeys);
for Index := 0 to SubKeys.Count - 1 do
begin
if Reg.KeyExists(SubKeys.Strings[Index] + ContextRegPathCommand) = True then
begin
Reg.CloseKey;
Reg.OpenKeyReadOnly(Key + '\' + SubKeys.Strings[Index]);
if Reg.ValueExists('') = True then
begin
Cptn := Reg.ReadString('');
end else
begin
Cptn := '';
end;
if Reg.ValueExists('icon') = True then
begin
Icn := Reg.ReadString('icon');
end else
begin
Icn := '';
end;
Reg.CloseKey;
Reg.OpenKeyReadOnly(Key + '\' + SubKeys.Strings[Index] + ContextRegPathCommand);
if Reg.ValueExists('') = True then
begin
Cmd := Reg.ReadString('');
end else
begin
Cmd := '';
end;
CreateMenuItem(SubKeys.Strings[Index],Cptn,Cmd,Icn);
end;
end;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
SubKeys.Free;
end;
end;
procedure TContextMenu.SaveToRegistry;
var
Reg: TRegistry;
Index: Integer;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKEY_CLASSES_ROOT;
Reg.Access := KEY_WRITE;
Reg.OpenKey(ExtStrToRegKey(Ext),True);
Reg.WriteString('',FAlias);
Reg.CloseKey;
for Index := 0 to Items.Count - 1 do
begin
CreateRegistryEntry(Reg,(Items.Items[Index] as TContextMenuItem).Name,
(Items.Items[Index] as TContextMenuItem).Caption,
(Items.Items[Index] as TContextMenuItem).Command,
(Items.Items[Index] as TContextMenuItem).Icon);
end;
finally
Reg.Free;
end;
end;
end.

244
Source/uFileTools.pas
View File

@ -19,7 +19,7 @@ uses
Generics.Collections,
{$ENDIF}
{ Andere Package-Units }
uBase;
uBase, uSysTools;
type
{ Fehlermeldungen }
@ -35,6 +35,8 @@ type
TFileExecuteMode = (feOpen,feEdit,feExplore,feFind,fePrint);
TFileNameStyles = set of (fnDirectory,fnExtension);
TFileAttributes = set of (faReadOnly,faHidden,faSystem,faArchive,faTemporary);
TInvalidFileName = String[4];
TInvalidFileNames = array[1..22] of TInvalidFileName;
type
{ Hauptklassen }
@ -105,20 +107,24 @@ type
TWinFileList = TList<TWinFile>;
{$ENDIF}
procedure InitializeInvalidNames;
function ValidFileName(const FileName: TInvalidFileName; const InvalidFileNames: TInvalidFileNames): Boolean;
function ValidFileNameStr(const FileName: ShortString; const InvalidFileNames: TInvalidFileNames): Boolean;
function StrIsPath(const S: String): Boolean;
function FEModeToPChar(FEMode: TFileExecuteMode): PChar;
procedure EnsureDirDelimeter(var Dir: String);
function ExecuteFile(FileName: String; ExecMode: TFileExecuteMode = feOpen;
InDir: Boolean = False): Boolean;
function ExtractFileFolder(FileName: String): String;
procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String;
NameStyles: TFileNameStyles = []);
procedure ListFolders(Dir: String; OutList: TStrings;
NameStyles: TFileNameStyles = []);
procedure ListFiles(Dir: String; var OutList: TStrings; FileExts: array of String;
NameStyles: TFileNameStyles = []; RecMode: Boolean = False);
procedure ListFolders(Dir: String; var OutList: TStrings;
NameStyles: TFileNameStyles = []; RecMode: Boolean = False);
function ExtractDriveChar(const FileName: String): Char;
function DriveCharToFileDir(DriveChar: Char): ShortString;
function DriveCharToFilePath(DriveChar: Char): ShortString;
function FileTimeToDateTime(FileTime: TFileTime): TDateTime;
function ConvertFileSize(const InputSize: Int64; ConvertFactor: ShortInt = 2): Extended;
function ConvertFileSize(const InputSize: Int64; ConvertFactor: ShortInt = -1): Extended;
function GetFileSize(FileName: String): Int64;
function GetFileModified(FileName: String): TDateTime;
function GetFileCreated(FileName: String): TDateTime;
@ -126,6 +132,11 @@ type
function GetFileAttributes(FileName: String): TFileAttributes;
const
PathDelims = [PathDelim,'/'];
MAX_PATH_DS = MAX_PATH - 1; //Max. Länge von Dateiname ohne #0-Terminal
{ Ungültige Dateinamen-Zeichen }
InvalidFilePathChars = ['*','?','"','<','>','|'];
InvalidFileNameChars = InvalidFilePathChars + ['\','/',':'];
{ Umrechnungs-Faktoren }
TB_TO_B = 4;
GB_TO_B = 3;
@ -148,17 +159,177 @@ const
KB_TO_TB = -3;
B_TO_TB = -4;
{ Dateierweiterungen für ListFiles() }
{FXT_ANY = '*.*'
FXT_EXE = ('*.exe');
FXT_TXT = ('*.txt';'*.rtf');
FXT_ANY = '*.*';
FXT_EXE = '*.exe';
FXT_TXT = '*.txt';
{ Vielleicht später mal implementieren...
FXT_IMG = ('*.jpg','*.jpeg','*.png','*.tif','*.tiff','*.bmp','*.gif');
FXT_PAS = ('*.pas','*.dpr','*.dpk','*.dfm');
FXT_MSO = ('*.doc','*.xls','*.ppt');
FXT_MSI = ('*.msi');
FXT_IMG = ('*.img','*.iso'); }
var
InvalidFileNames: TInvalidFileNames;
implementation
procedure InitializeInvalidNames;
begin
InvalidFileNames[01] := 'CON';
InvalidFileNames[02] := 'PRN';
InvalidFileNames[03] := 'AUX';
InvalidFileNames[04] := 'NUL';
{ COM... }
InvalidFileNames[05] := 'COM1';
InvalidFileNames[06] := 'COM2';
InvalidFileNames[07] := 'COM3';
InvalidFileNames[08] := 'COM4';
InvalidFileNames[09] := 'COM5';
InvalidFileNames[10] := 'COM6';
InvalidFileNames[11] := 'COM7';
InvalidFileNames[12] := 'COM8';
InvalidFileNames[13] := 'COM9';
{ LPT... }
InvalidFileNames[14] := 'LPT1';
InvalidFileNames[15] := 'LPT2';
InvalidFileNames[16] := 'LPT3';
InvalidFileNames[17] := 'LPT4';
InvalidFileNames[18] := 'LPT5';
InvalidFileNames[19] := 'LPT6';
InvalidFileNames[20] := 'LPT7';
InvalidFileNames[21] := 'LPT8';
InvalidFileNames[22] := 'LPT9';
end;
function ValidFileName(const FileName: TInvalidFileName;
const InvalidFileNames: TInvalidFileNames): Boolean;
var
Index: 1..22;
begin
InitializeInvalidNames;
Result := True;
for Index := Low(InvalidFileNames) to High(InvalidFileNames) do
begin
if InvalidFileNames[Index] = FileName then
begin
Result := False;
Exit;
end;
end;
end;
function ValidFileNameStr(const FileName: ShortString;
const InvalidFileNames: TInvalidFileNames): Boolean;
var
Index: 1..4;
TmpIFN: TInvalidFileName;
begin
Result := True;
if Length(FileName) > 4 then
begin
Exit;
end;
for Index := 1 to 4 do
begin
TmpIFN := TmpIFN + FileName[Index];
end;
Result := ValidFileName(TmpIFN,InvalidFileNames);
end;
function StrIsPath(const S: String): Boolean;
{ Prüft, ob ein Dateipfad unter Windows-Systemen gültig ist.
An dieser stelle sei gesagt: Der Rückgabewert dieser Funktion ist lediglich
ein Anhaltspunkt und keine Garantie!
Außerdem wird nicht geprüft, ob die Datei existiert. }
var
Index: 1..MAX_PATH_DS; //Integer[1..259]
SLength: SmallInt;
NoPathDelim: Boolean;
NeedPathDelim: Boolean;
FileName: ShortString;
begin
Result := True;
SLength := Length(S);
if SLength = 0 then
begin
Exit;
end;
if SLength > MAX_PATH_DS then
begin
Result := False;
Exit;
end;
{ Prüfen, ob Dateiname ungültig ist }
FileName := '';
for Index := SLength downto 1 do
begin
if S[Index] in PathDelims then
begin
Break;
end else
begin
FileName := S[Index] + FileName;
end;
end;
if ValidFileNameStr(FileName,InvalidFileNames) = False then
begin
Result := False;
Exit;
end;
{ Parse... }
NoPathDelim := True;
NeedPathDelim := False;
for Index := 1 to SLength do
begin
{ -> Doppel-Slash verhindern }
if NoPathDelim = True then
begin
if S[Index] in PathDelims then
begin
Result := False;
Exit;
end else
begin
NoPathDelim := False;
end;
end else
begin
NoPathDelim := (S[Index] in PathDelims);
end;
{ -> Drive-Char validieren }
if (NeedPathDelim = True) then
begin
if S[Index] in PathDelims then
begin
NeedPathDelim := False;
end else
begin
Result := False;
Exit;
end;
end;
if S[Index] = DriveDelim then
begin
if Index = 2 then
begin
NeedPathDelim := True;
end else
begin
Result := False;
Exit;
end;
end;
{ -> Auf ungültige Zeichen prüfen }
if S[Index] in InvalidFilePathChars then
begin
Result := False;
Exit;
end;
//For
end;
end;
function FEModeToPChar(FEMode: TFileExecuteMode): PChar;
begin
case FEMode of
@ -191,8 +362,8 @@ begin
end;
end;
procedure ListFiles(Dir: String; OutList: TStrings; FileExts: array of String;
NameStyles: TFileNameStyles = []);
procedure ListFiles(Dir: String; var OutList: TStrings; FileExts: array of String;
NameStyles: TFileNameStyles = []; RecMode: Boolean = False);
var
SRec: TSearchRec;
ExtIndex: Integer;
@ -204,21 +375,32 @@ begin
end;
for ExtIndex := Low(FileExts) to High(FileExts) do
begin
if FindFirst(Dir + FileExts[ExtIndex],faAnyFile,SRec) = 0 then
if FindFirst(Dir + '*.*',faAnyFile,SRec) = 0 then
begin
repeat
if ((SRec.Attr and faDirectory) <> faDirectory) and
(SRec.Name <> '.') and (SRec.Name <> '..') and
(ChangeFileExt(SRec.Name,ExtractFileExt(FileExts[ExtIndex])) = SRec.Name) then
if (SRec.Name <> '.') and (SRec.Name <> '..') then
begin
OutList.Add(SRec.Name);
if fnDirectory in NameStyles then
if ((SRec.Attr and faDirectory) = faDirectory) then
begin
OutList.Strings[OutList.Count - 1] := Dir + OutList.Strings[OutList.Count - 1];
end;
if not (fnExtension in NameStyles) then
if RecMode = True then
begin
ListFiles(Dir + SRec.Name,OutList,FileExts,NameStyles,RecMode);
end;
end else
begin
OutList.Strings[OutList.Count - 1] := ChangeFileExt(OutList.Strings[OutList.Count - 1],'');
if ((ChangeFileExt(SRec.Name,ExtractFileExt(FileExts[ExtIndex])) = SRec.Name) or
(ExtractFileExt(FileExts[ExtIndex]) = '.*')) then
begin
OutList.Add(SRec.Name);
if fnDirectory in NameStyles then
begin
OutList.Strings[OutList.Count - 1] := Dir + OutList.Strings[OutList.Count - 1];
end;
if not (fnExtension in NameStyles) then
begin
OutList.Strings[OutList.Count - 1] := ChangeFileExt(OutList.Strings[OutList.Count - 1],'');
end;
end;
end;
end;
until FindNext(SRec) <> 0;
@ -227,8 +409,8 @@ begin
end;
end;
procedure ListFolders(Dir: String; OutList: TStrings;
NameStyles: TFileNameStyles = []);
procedure ListFolders(Dir: String; var OutList: TStrings;
NameStyles: TFileNameStyles = []; RecMode: Boolean = False);
var
SRec: TSearchRec;
begin
@ -245,6 +427,10 @@ begin
end else
begin
OutList.Add(SRec.Name);
if RecMode = True then
begin
ListFolders(Dir + SRec.Name,OutList,NameStyles,RecMode);
end;
end;
end;
until FindNext(SRec) <> 0;
@ -290,7 +476,7 @@ begin
begin
if Length(FileName) >= 3 then
begin
if FileName[3] <> PathDelim then
if not (FileName[3] in PathDelims) then
begin
Result := #0;
end;
@ -319,7 +505,7 @@ begin
Result := SystemTimeToDateTime(SysTime);
end;
function ConvertFileSize(const InputSize: Int64; ConvertFactor: ShortInt = 2): Extended;
function ConvertFileSize(const InputSize: Int64; ConvertFactor: ShortInt = -1): Extended;
begin
{ Sollte verwendet werden mit den Umrechnungs-Faktoren, die in der globalen
"const"-Section deklariert wurden. }
@ -613,10 +799,10 @@ var
OwnerName, DomainName: PChar;
OwnerType: SID_NAME_USE;
begin
GetMem(SecDescr, 1024);
GetMem(OwnerSID, SizeOf(PSID));
GetMem(OwnerName, 1024);
GetMem(DomainName, 1024);
GetMem(SecDescr,1024);
GetMem(OwnerSID,SizeOf(PSID));
GetMem(OwnerName,1024);
GetMem(DomainName,1024);
try
if GetFileSecurity(PChar(FFileName),OWNER_SECURITY_INFORMATION,SecDescr,1024,SizeNeeded) = True then
begin

109
Source/uFrmCtrls.pas
View File

@ -17,6 +17,7 @@ uses
type
{ Fehlermeldungen }
EInvalidParamChar = class(Exception);
EParamNotFound = class(Exception);
EInvalidParamIdentifier = class(Exception);
EInvalidParamFormat = class(Exception);
@ -366,20 +367,21 @@ type
{ Private-Deklarationen }
FPrefix: String;
FSuffix: String;
FSeperator: String;
FSeparator: String;
{ Methoden }
procedure SetPrefix(Value: String);
procedure SetSuffix(Value: String);
procedure SetSeperator(Value: String);
procedure SetSeparator(Value: String);
public
{ Public-Deklarationen }
constructor Create;
constructor Create; overload;
constructor Create(APrefix,ASeparator,ASuffix: String); overload;
destructor Destroy; override;
published
{ Published-Deklarationen }
property Prefix: String read FPrefix write SetPrefix;
property Suffix: String read FSuffix write SetSuffix;
property Seperator: String read FSeperator write SetSeperator;
property Separator: String read FSeparator write SetSeparator;
end;
TParamReference = class(TCollectionItem)
@ -397,6 +399,7 @@ type
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
procedure Update;
function AsText(UseDefVal: Boolean = False): String;
{ Eigenschaften }
property Connector: PString read FConnector write FConnector;
published
@ -432,6 +435,9 @@ type
end;
procedure ListParams(var OutList: TStrings);
function StringFromParam(Ident,Value: String; Format: TParamFormat): String;
function StringFromParamRef(ParamRef: TParamReference; UseDefVal: Boolean = True): String;
function StringFromParams(Idents,Values: TStrings; Format: TParamFormat): String;
procedure Register;
@ -475,6 +481,66 @@ begin
end;
end;
function StringFromParam(Ident,Value: String; Format: TParamFormat): String;
var
TmpStr: String;
Index: Integer;
RequireQuotes: Boolean;
begin
Result := '';
TmpStr := Format.Prefix + Ident + Format.Separator + Value + Format.Suffix;
RequireQuotes := False;
for Index := 1 to Length(TmpStr) do
begin
if TmpStr[Index] in Spaces then
begin
RequireQuotes := True;
end;
if TmpStr[Index] in ['''','"'] then
begin
raise EInvalidParamChar.Create('Invalid character at position: ' + IntToStr(Index));
end;
end;
if RequireQuotes = True then
begin
Result := '"' + TmpStr + '"';
end else
begin
Result := TmpStr;
end;
end;
function StringFromParamRef(ParamRef: TParamReference; UseDefVal: Boolean = True): String;
var
Value: String;
begin
if UseDefVal = True then
begin
Value := ParamRef.DefaultValue;
end else
begin
Value := ParamRef.Connector^;
end;
Result := StringFromParam(ParamRef.Identifier,Value,ParamRef.Format);
end;
function StringFromParams(Idents,Values: TStrings; Format: TParamFormat): String;
var
TmpStr: String;
Index: Integer;
begin
Result := '';
for Index := 0 to Idents.Count do
begin
if Index > 0 then
begin
TmpStr := TmpStr + ' ';
end;
TmpStr := TmpStr + StringFromParam(Idents.Strings[Index],Values[Index],Format);
end;
Result := TmpStr;
end;
{ ----------------------------------------------------------------------------
TSplashObject
---------------------------------------------------------------------------- }
@ -1466,6 +1532,14 @@ begin
//...
end;
constructor TParamFormat.Create(APrefix,ASeparator,ASuffix: String);
begin
Create;
Prefix := APrefix;
Separator := ASeparator;
Suffix := ASuffix;
end;
destructor TParamFormat.Destroy;
begin
//...
@ -1481,11 +1555,9 @@ begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Prefix"');
end else
begin
FPrefix := Value;
end;
end;
FPrefix := Value;
end;
procedure TParamFormat.SetSuffix(Value: String);
@ -1497,14 +1569,12 @@ begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Suffix"');
end else
begin
FSuffix := Value;
end;
end;
FSuffix := Value;
end;
procedure TParamFormat.SetSeperator(Value: String);
procedure TParamFormat.SetSeparator(Value: String);
var
Index: Integer;
begin
@ -1513,11 +1583,9 @@ begin
if Value[Index] in [#34,#39] then
begin
raise EInvalidParamFormat.Create('Invalid param format for property: "Seperator"');
end else
begin
FSeperator := Value;
end;
end;
FSeparator := Value;
end;
{ ----------------------------------------------------------------------------
@ -1609,7 +1677,7 @@ begin
//[----X]
if InSuffix = True then
begin
if (ParamItem[CharIndex] = Format.Suffix[CharIndex - Length(Format.Prefix + Identifier + Format.Seperator + Value)]) then
if (ParamItem[CharIndex] = Format.Suffix[CharIndex - Length(Format.Prefix + Identifier + Format.Separator + Value)]) then
begin
if CharIndex = Length(ParamItem) then
begin
@ -1627,15 +1695,15 @@ begin
//[--X--]
if InSep = True then
begin
if Length(Format.Seperator) = 0 then
if Length(Format.Separator) = 0 then
begin
InSep := False;
InDef := True;
Continue;
end;
if ParamItem[CharIndex] = Format.Seperator[CharIndex - Length(Format.Prefix + Identifier)] then
if ParamItem[CharIndex] = Format.Separator[CharIndex - Length(Format.Prefix + Identifier)] then
begin
if CharIndex = Length(Format.Prefix + Identifier + Format.Seperator) then
if CharIndex = Length(Format.Prefix + Identifier + Format.Separator) then
begin
InSep := False;
InDef := True;
@ -1686,6 +1754,11 @@ begin
raise EParamNotFound.Create('Parameter "' + Identifier + '" not found');
end;
function TParamReference.AsText(UseDefVal: Boolean = False): String;
begin
Result := StringFromParamRef(Self,UseDefVal);
end;
{ ----------------------------------------------------------------------------
TParamDefiner
---------------------------------------------------------------------------- }

164
Source/uScriptMgr.pas
View File

@ -52,6 +52,29 @@ type
type
{ Hauptklassen }
TScriptManager = class;
TScriptManagerPlugins = class(TPersistent)
private
{ Private-Deklarationen }
FScriptManager: TScriptManager;
{ Methoden }
function GetScriptManager: TScriptManager;
procedure SetScriptManager(Value: TScriptManager);
function GetItems(Index: Integer): TPSPlugin;
procedure SetItems(Index: Integer; Value: TPSPlugin);
function GetCount: Integer;
public
{ Public-Deklarationen }
constructor Create(AScriptManager: TScriptManager);
destructor Destroy; override;
property ScriptManager: TScriptManager read GetScriptManager write SetScriptManager;
property Items[Index: Integer]: TPSPlugin read GetItems write SetItems;
property Count: Integer read GetCount;
procedure Add(Plugin: TPSPlugin);
procedure Delete(Plugin: TPSPlugin);
end;
TScriptManager = class(TComponent)
private
{ Private-Deklarationen }
@ -67,6 +90,7 @@ type
FVarApplication: TApplication;
FVarSelf: TForm;
FLibraries: TScriptLibraries;
FPlugins: TScriptManagerPlugins;
{ Ereignisse }
FCreateEvent: TScriptCreateEvent;
FDestroyEvent: TScriptDestroyEvent;
@ -80,21 +104,20 @@ type
FCodeLoadEvent: TScriptCodeLoadEvent;
{ Methoden }
function GetCompilerOptions: TPSCompOptions;
procedure SetCompilerOptions(const Value: TPSCompOptions);
function GetCodeLines(Index: Integer): String; //Int. Dekl. für: CodeLines[Index]
procedure SetCodeLines(Index: Integer; const Value: String); //Int. Dekl. für: CodeLines[Index]
procedure SetCompilerOptions(Value: TPSCompOptions);
function GetCodeLines(Index: Integer): String; //Int. Dekl. für: CodeLines[Index]
procedure SetCodeLines(Index: Integer; Value: String); //Int. Dekl. für: CodeLines[Index]
function GetCodeCount: Integer;
function GetRunning: Boolean;
function GetPluginItems(Index: Integer): TPSPlugin;
procedure SetPluginItems(Index: Integer; const Value: TPSPlugin);
procedure SetLibraries(const Value: TScriptLibraries);
procedure SetLibraries(Value: TScriptLibraries);
function GetUsePreProcessor: Boolean;
procedure SetUsePreProcessor(const Value: Boolean);
procedure SetUsePreProcessor(Value: Boolean);
function GetMainFileName: AnsiString;
procedure SetMainFileName(const Value: AnsiString);
procedure SetMainFileName(Value: AnsiString);
function GetDefines: TStrings;
procedure SetDefines(const Value: TStrings);
function GetPluginCount: Integer;
procedure SetDefines(Value: TStrings);
function GetPlugins: TScriptManagerPlugins;
procedure SetPlugins(Value: TScriptManagerPlugins);
published
{ Published-Deklarationen }
{ Ereignisse}
@ -109,6 +132,7 @@ type
property OnCodeAssign: TScriptCodeAssignEvent read FCodeAssignEvent write FCodeAssignEvent;
property OnCodeLoad: TScriptCodeLoadEvent read FCodeLoadEvent write FCodeLoadEvent;
{ Eigenschaften }
property About: TComponentAbout read FAbout;
property CompilerOptions: TPSCompOptions read GetCompilerOptions write SetCompilerOptions default [];
property ReturnMode: TScriptReturnMode read FReturnMode write FReturnMode default srNone; //Wann soll eine Rückmeldung erfolgen?
property ReturnStyle: TScriptReturnStyle read FReturnStyle write FReturnStyle default srSimple; //Wie soll diese Rückmeldung aussehen?
@ -119,9 +143,7 @@ type
property Libraries: TScriptLibraries read FLibraries write SetLibraries default [slClasses,slControls,slStdCtrls,slForms,slDateUtils,slCustom];
property UsePreProcessor: Boolean read GetUsePreProcessor write SetUsePreProcessor; //Sind "Include"-Anweisungen erlaubt?
property MainFileName: AnsiString read GetMainFileName write SetMainFileName; //Dateiname für "Include"-Anweisungen
property Defines: TStrings read GetDefines write SetDefines; //Standardwerte für "Include"-Anweisung
{ Meta-Daten }
property About: TComponentAbout read FAbout;
property Defines: TStrings read GetDefines write SetDefines;
protected
{ Protected-Deklarationen }
procedure AddLog(Entry: String);
@ -156,10 +178,7 @@ type
procedure CodeAssign(Source: TPersistent);
procedure CodeClear;
function CompileAndExecute: Boolean;
property PluginItems[Index: Integer]: TPSPlugin read GetPluginItems write SetPluginItems;
property PluginCount: Integer read GetPluginCount;
procedure PluginAdd(Plugin: TPSPlugin);
procedure PluginDelete(Plugin: TPSPlugin);
property Plugins: TScriptManagerPlugins read GetPlugins write SetPlugins;
end;
procedure AddPlugin(PluginList: TPSPlugins; Plugin: TPSPlugin);
@ -205,10 +224,10 @@ var
Index: Integer;
PluginFound: Boolean;
begin
PluginFound := False;
Index := 0;
if PluginList.Count > Index then
begin
PluginFound := False;
repeat
if TPSPluginItem(PluginList.Items[Index]).Plugin = Plugin then
begin
@ -223,6 +242,62 @@ begin
end;
end;
{ ----------------------------------------------------------------------------
TScriptManagerPlugins
---------------------------------------------------------------------------- }
constructor TScriptManagerPlugins.Create(AScriptManager: TScriptManager);
begin
FScriptManager := AScriptManager;
end;
destructor TScriptManagerPlugins.Destroy;
begin
//...
inherited;
end;
function TScriptManagerPlugins.GetScriptManager: TScriptManager;
begin
Result := FScriptManager;
end;
procedure TScriptManagerPlugins.SetScriptManager(Value: TScriptManager);
begin
FScriptManager := Value;
end;
procedure TScriptManagerPlugins.Add(Plugin: TPSPlugin);
begin
AddPlugin(FScriptManager.CustomPlugins,Plugin);
FScriptManager.SetLibraries(FScriptManager.Libraries);
end;
procedure TScriptManagerPlugins.Delete(Plugin: TPSPlugin);
begin
DeletePlugin(FScriptManager.CustomPlugins,Plugin);
FScriptManager.SetLibraries(FScriptManager.Libraries);
end;
function TScriptManagerPlugins.GetItems(Index: Integer): TPSPlugin;
begin
Result := TPSPluginItem(Items[Index]).Plugin;
end;
procedure TScriptManagerPlugins.SetItems(Index: Integer; Value: TPSPlugin);
begin
TPSPluginItem( Items[Index]).Plugin := Value;
end;
function TScriptManagerPlugins.GetCount: Integer;
begin
Result := FScriptManager.Plugins.Count;
end;
{ ----------------------------------------------------------------------------
TScriptManager
---------------------------------------------------------------------------- }
constructor TScriptManager.Create(AOwner: TComponent);
begin
inherited;
@ -236,6 +311,7 @@ begin
begin
VarSelf := (Self.Owner as TForm);
end;
Plugins := TScriptManagerPlugins.Create(Self);
Log := TStringList.Create;
Code := TStringList.Create;
CustomPlugins := TPSPlugins.Create(ScriptEngine);
@ -271,6 +347,7 @@ begin
VarApplication := nil;
ReturnMode := srNone;
ReturnStyle := srSimple;
Plugins.Free;
//ReturnSL.Free; Pointer auf ext. Komponente, nicht freigeben
Log.Free;
Code.Free;
@ -293,7 +370,7 @@ begin
Result := ScriptEngine.CompilerOptions;
end;
procedure TScriptManager.SetCompilerOptions(const Value: TPSCompOptions);
procedure TScriptManager.SetCompilerOptions(Value: TPSCompOptions);
begin
ScriptEngine.CompilerOptions := Value;
ScriptEngine.Stop
@ -310,7 +387,7 @@ begin
end;
end;
procedure TScriptManager.SetCodeLines(Index: Integer; const Value: String);
procedure TScriptManager.SetCodeLines(Index: Integer; Value: String);
begin
if (Index >= 0) and (Index <= Code.Count - 1) then
begin
@ -340,22 +417,7 @@ begin
ScriptEngine.Stop;
end;
function TScriptManager.GetPluginItems(Index: Integer): TPSPlugin;
begin
Result := TPSPluginItem(CustomPlugins.Items[Index]).Plugin;
end;
procedure TScriptManager.SetPluginItems(Index: Integer; const Value: TPSPlugin);
begin
TPSPluginItem(CustomPlugins.Items[Index]).Plugin := Value;
end;
function TScriptManager.GetPluginCount: Integer;
begin
Result := ScriptEngine.Plugins.Count;
end;
procedure TScriptManager.SetLibraries(const Value: TScriptLibraries);
procedure TScriptManager.SetLibraries(Value: TScriptLibraries);
begin
ScriptEngine.Plugins.Clear;
FLibraries := Value;
@ -408,7 +470,7 @@ begin
Result := ScriptEngine.UsePreProcessor;
end;
procedure TScriptManager.SetUsePreProcessor(const Value: Boolean);
procedure TScriptManager.SetUsePreProcessor(Value: Boolean);
begin
ScriptEngine.UsePreProcessor := Value;
end;
@ -418,7 +480,7 @@ begin
Result := ScriptEngine.MainFileName;
end;
procedure TScriptManager.SetMainFileName(const Value: AnsiString);
procedure TScriptManager.SetMainFileName(Value: AnsiString);
begin
ScriptEngine.MainFileName := Value;
end;
@ -428,11 +490,21 @@ begin
Result := ScriptEngine.Defines;
end;
procedure TScriptManager.SetDefines(const Value: TStrings);
procedure TScriptManager.SetDefines(Value: TStrings);
begin
ScriptEngine.Defines := Value;
end;
function TScriptManager.GetPlugins: TScriptManagerPlugins;
begin
Result := FPlugins;
end;
procedure TScriptManager.SetPlugins(Value: TScriptManagerPlugins);
begin
FPlugins := Value;
end;
procedure TScriptManager.AddLog(Entry: string);
const
PrefixBegin = '[';
@ -500,7 +572,7 @@ begin
begin
if (ReturnMode = srAll) or (ReturnMode = srErrors) then
begin
AddLog(ScriptEngine.ExecErrorToString + ' at ' + Inttostr(ScriptEngine.ExecErrorProcNo) + '.'+Inttostr(ScriptEngine.ExecErrorByteCodePosition));
AddLog(ScriptEngine.ExecErrorToString + ' at ' + IntToStr(ScriptEngine.ExecErrorProcNo) + '.'+IntToStr(ScriptEngine.ExecErrorByteCodePosition));
end;
end else
begin
@ -582,18 +654,6 @@ begin
end;
end;
procedure TScriptManager.PluginAdd(Plugin: TPSPlugin);
begin
AddPlugin(CustomPlugins,Plugin);
SetLibraries(Libraries);
end;
procedure TScriptManager.PluginDelete(Plugin: TPSPlugin);
begin
DeletePlugin(CustomPlugins,Plugin);
SetLibraries(Libraries);
end;
function TScriptManager.ScriptEngineNeedFile(Sender:TObject; const OriginFileName: AnsiString; var FileName, Output: AnsiString): Boolean;
begin
Result := ScriptEngine.OnNeedFile(Sender,OriginFileName,FileName,Output);

21
Source/uSysTools.pas
View File

@ -15,7 +15,7 @@ uses
Generics.Collections,
{$ENDIF}
{ Andere Package-Units }
uFileTools, uBase;
uBase;
type
{ Fehlermeldungen }
@ -80,6 +80,7 @@ type
function WinUserExists(UsrNme: String): Boolean;
{ Array-Position }
function ArrayPos(const AValue: Variant; const AArray: array of Variant): Integer; overload;
function ArrayPos(const AValue: Char; const AArray: array of Char): Integer; overload;
function ArrayPos(const AValue: String; const AArray: array of String): Integer; overload;
function ArrayPos(const AValue: Integer; const AArray: array of Integer): Integer; overload;
function ArrayPos(const AValue: Extended; const AArray: array of Extended): Integer; overload;
@ -108,6 +109,9 @@ const
implementation
uses
uFileTools;
function BoolToInt(B: Boolean): Integer;
begin
if B then
@ -250,6 +254,21 @@ begin
end;
end;
function ArrayPos(const AValue: Char; const AArray: array of Char): Integer; overload;
var
Index: Integer;
begin
Result := Low(AArray) - 1;
for Index := Low(AArray) to High(AArray) do
begin
if AArray[Index] = AValue then
begin
Result := Index;
Exit;
end;
end;
end;
function ArrayPos(const AValue: String; const AArray: array of String): Integer; overload;
var
Index: Integer;

5
Source/uWebCtrls.pas
View File

@ -124,10 +124,12 @@ begin
WebProtocolsSpecial[3] := WP_FTP;
end;
function ValidProtocol(const Protocol: TWebProtocol; const Protocols: TWebProtocols): Boolean;
function ValidProtocol(const Protocol: TWebProtocol;
const Protocols: TWebProtocols): Boolean;
var
Index: 1..5;
begin
InitializeProtocols;
Result := False;
for Index := Low(Protocols) to High(Protocols) do
begin
@ -155,7 +157,6 @@ var
ProtocolValid: Boolean;
DoubleSlashRequired: Boolean;
begin
InitializeProtocols;
Result := True;
ProtocolValid := False;
DoubleSlashRequired := False;