diff --git a/Example/TLocalizationManager/pExample.exe b/Example/TLocalizationManager/pExample.exe index 7e8c370..89fba6b 100644 Binary files a/Example/TLocalizationManager/pExample.exe and b/Example/TLocalizationManager/pExample.exe differ diff --git a/Example/TLocalizationManager/uMain.dfm b/Example/TLocalizationManager/uMain.dfm index 1cbae45..9320115 100644 --- a/Example/TLocalizationManager/uMain.dfm +++ b/Example/TLocalizationManager/uMain.dfm @@ -66,20 +66,23 @@ object Form1: TForm1 Indent = 'HelloWorld' end item - Section = 'Buttons' - Indent = 'Close' - Component = btClose + Component = gbLaguage + Indent = 'LanguageSelect' + Field = 'Caption' end item + Component = btHello Section = 'Buttons' Indent = 'Hello' - Component = btHello + Field = 'Caption' end item - Indent = 'LanguageSelect' - Component = gbLaguage + Component = btClose + Section = 'Buttons' + Indent = 'Close' + Field = 'Caption' end> - Left = 288 - Top = 8 + Left = 240 + Top = 32 end end diff --git a/Example/TLocalizationManager/uMain.pas b/Example/TLocalizationManager/uMain.pas index 501b342..0f8f550 100644 --- a/Example/TLocalizationManager/uMain.pas +++ b/Example/TLocalizationManager/uMain.pas @@ -58,6 +58,7 @@ var Index: Integer; LanguageFiles: TStrings; begin + LocalizationManager.References.Add; HelloWorld := 'Hello,' + #10 + 'World!'; (LocalizationManager.References.Items[0] as TLocalizationReference).Reference := @HelloWorld; LanguageFiles := TStringList.Create; diff --git a/Information/Statistics.txt b/Information/Statistics.txt index 3e1b89e..dfb9dcc 100644 --- a/Information/Statistics.txt +++ b/Information/Statistics.txt @@ -1,4 +1,4 @@ These statistics cover the official repository of Lina Components. -Total lines of code (LoC): 8300+ -Total visual components (VC): 15 \ No newline at end of file +Total lines of code (LoC): 9500+ +Total visual components (VC): 16 \ No newline at end of file diff --git a/Package/Delphi_XE5/LINA_D_XE5.dpk b/Package/Delphi_XE5/LINA_D_XE5.dpk index 24f10a1..775f407 100644 --- a/Package/Delphi_XE5/LINA_D_XE5.dpk +++ b/Package/Delphi_XE5/LINA_D_XE5.dpk @@ -3,6 +3,7 @@ package LINA_D_XE5; {$R *.res} {$R '..\..\Resource\Compiled\LINA.dcr'} {$R '..\..\Resource\Compiled\uAdvCtrls.dcr'} +{$R '..\..\Resource\Compiled\uCalc.dcr'} {$R '..\..\Resource\Compiled\uSysCtrls.dcr'} {$R '..\..\Resource\Compiled\uFileCtrls.dcr'} {$R '..\..\Resource\Compiled\uFrmCtrls.dcr'} @@ -59,7 +60,8 @@ contains uAdvCtrls in '..\..\Source\uAdvCtrls.pas', uWebCtrls in '..\..\Source\uWebCtrls.pas', uFileCtrls in '..\..\Source\uFileCtrls.pas', - uInit in '..\..\Source\uInit.pas'; + uInit in '..\..\Source\uInit.pas', + uCalc in '..\..\Source\uCalc.pas'; end. diff --git a/Package/Delphi_XE5/LINA_D_XE5.dproj b/Package/Delphi_XE5/LINA_D_XE5.dproj index 01d854e..a89a75b 100644 --- a/Package/Delphi_XE5/LINA_D_XE5.dproj +++ b/Package/Delphi_XE5/LINA_D_XE5.dproj @@ -45,6 +45,7 @@ true + 3 All true System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) @@ -75,6 +76,7 @@ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) + 3 DEBUG;$(DCC_Define) true false @@ -103,6 +105,7 @@ + @@ -130,6 +133,7 @@ + Cfg_2 Base diff --git a/Package/Delphi_XE5/LINA_D_XE5.dproj.local b/Package/Delphi_XE5/LINA_D_XE5.dproj.local index 7f673e8..e79ad5c 100644 --- a/Package/Delphi_XE5/LINA_D_XE5.dproj.local +++ b/Package/Delphi_XE5/LINA_D_XE5.dproj.local @@ -1,49 +1,50 @@  + 1899.12.30 00:00:00.000.576,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysTools.pas + 1899.12.30 00:00:00.000.508,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBase.pas + 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 + 1899.12.30 00:00:00.000.518,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas + 1899.12.30 00:00:00.000.173,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uInit.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 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 + 1899.12.30 00:00:00.000.592,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uFileTools.pas + 1899.12.30 00:00:00.000.412,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 1899.12.30 00:00:00.000.325,=dbrtl.dcp 1899.12.30 00:00:00.000.809,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc 1899.12.30 00:00:00.000.681,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Resource\Lina.rc= - 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 - 1899.12.30 00:00:00.000.508,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBase.pas - 1899.12.30 00:00:00.000.576,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uSysTools.pas - 1899.12.30 00:00:00.000.674,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas - 1899.12.30 00:00:00.000.837,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas - 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 - 1899.12.30 00:00:00.000.592,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uFileTools.pas - 1899.12.30 00:00:00.000.325,=dbrtl.dcp - 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 1899.12.30 00:00:00.000.143,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Untitled1.htm - 1899.12.30 00:00:00.000.556,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uLocalMgr.pas - 1899.12.30 00:00:00.000.414,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas= + 1899.12.30 00:00:00.000.318,=vcl.dcp + 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 + 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 1899.12.30 00:00:00.000.577,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBattery.pas 1899.12.30 00:00:00.000.621,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas - 1899.12.30 00:00:00.000.648,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uScriptMgr.pas - 1899.12.30 00:00:00.000.518,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uBattery.pas 1899.12.30 00:00:00.000.896,C:\Users\Dennis G\Documents\CodeQuality.htm= - 1899.12.30 00:00:00.000.318,=vcl.dcp - 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 - 1899.12.30 00:00:00.000.791,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 1899.12.30 00:00:00.000.648,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uScriptMgr.pas + 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 + 1899.12.30 00:00:00.000.414,C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLinaTest.pas= + 1899.12.30 00:00:00.000.556,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uLocalMgr.pas + 1899.12.30 00:00:00.000.555,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBase.pas + 1899.12.30 00:00:00.000.075,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCalc.pas 1899.12.30 00:00:00.000.971,=IndySystem.dcp 1899.12.30 00:00:00.000.196,=rtl.dcp - 1899.12.30 00:00:00.000.555,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uBase.pas - 1899.12.30 00:00:00.000.686,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uSysTools.pas 1899.12.30 00:00:00.000.584,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uVirtObj.pas + 1899.12.30 00:00:00.000.686,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uSysTools.pas 1899.12.30 00:00:00.000.118,=IndyCore.dcp 1899.12.30 00:00:00.000.535,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFileTools.pas - 1899.12.30 00:00:00.000.633,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLocalMgr.pas - 1899.12.30 00:00:00.000.525,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCrypt.pas + 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 1899.12.30 00:00:00.000.672,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\uFrmCtrls.pas - 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 - 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 - 1899.12.30 00:00:00.000.173,C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uInit.pas - 1899.12.30 00:00:00.000.412,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas - 1899.12.30 00:00:00.000.675,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas - 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 - 1899.12.30 00:00:00.000.857,=PascalScript_Core_D19.dcp - 1899.12.30 00:00:00.000.045,=IndyProtocols.dcp - 1899.12.30 00:00:00.000.799,=PascalScript_Core_D19.dcp - 1899.12.30 00:00:00.000.566,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uScriptMgr.pas + 1899.12.30 00:00:00.000.633,=C:\Users\Dennis\Documents\RAD Studio\Projekte\LinaComponents\uLocalMgr.pas + 1899.12.30 00:00:00.000.791,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas 1899.12.30 00:00:00.000.546,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uFrmCtrls.pas + 1899.12.30 00:00:00.000.674,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 1899.12.30 00:00:00.000.837,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 1899.12.30 00:00:00.000.675,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Package\Delphi_XE5\Unit1.pas + 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 + 1899.12.30 00:00:00.000.045,=IndyProtocols.dcp + 1899.12.30 00:00:00.000.525,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uCrypt.pas + 1899.12.30 00:00:00.000.857,=PascalScript_Core_D19.dcp + 1899.12.30 00:00:00.000.566,=C:\Users\Dennis G\Documents\RAD Studio\Projekte\LinaComponents\Source\uScriptMgr.pas + 1899.12.30 00:00:00.000.799,=PascalScript_Core_D19.dcp @@ -51,16 +52,18 @@ - + + + diff --git a/Package/Delphi_XE5/LINA_D_XE5.identcache b/Package/Delphi_XE5/LINA_D_XE5.identcache index 4a5ddce..abd1c66 100644 Binary files a/Package/Delphi_XE5/LINA_D_XE5.identcache and b/Package/Delphi_XE5/LINA_D_XE5.identcache differ diff --git a/Resource/Bitmap/Large/TCalculator.bmp b/Resource/Bitmap/Large/TCalculator.bmp new file mode 100644 index 0000000..946da2f Binary files /dev/null and b/Resource/Bitmap/Large/TCalculator.bmp differ diff --git a/Resource/Bitmap/Small/TCalculator.bmp b/Resource/Bitmap/Small/TCalculator.bmp new file mode 100644 index 0000000..09a825e Binary files /dev/null and b/Resource/Bitmap/Small/TCalculator.bmp differ diff --git a/Resource/Bitmap/TCalculator.bmp b/Resource/Bitmap/TCalculator.bmp new file mode 100644 index 0000000..7ff5b32 Binary files /dev/null and b/Resource/Bitmap/TCalculator.bmp differ diff --git a/Resource/Compiled/uCalc.dcr b/Resource/Compiled/uCalc.dcr new file mode 100644 index 0000000..9ab7229 Binary files /dev/null and b/Resource/Compiled/uCalc.dcr differ diff --git a/Resource/LINA.rc b/Resource/LINA.rc index b57c0ba..610f2fd 100644 --- a/Resource/LINA.rc +++ b/Resource/LINA.rc @@ -2,6 +2,9 @@ LINA BITMAP "Bitmap\LINA.bmp" TBATTERY BITMAP "Bitmap\TBattery.bmp" TBATTERY16 BITMAP "Bitmap\Small\TBattery.bmp" TBATTERY32 BITMAP "Bitmap\Large\TBattery.bmp" +TCALCULATOR BITMAP "Bitmap\TCalculator.bmp" +TCALCULATOR16 BITMAP "Bitmap\Small\TCalculator.bmp" +TCALCULATOR32 BITMAP "Bitmap\Large\TCalculator.bmp" TCOMMANDBUTTON BITMAP "Bitmap\TCommandButton.bmp" TCOMMANDBUTTON16 BITMAP "Bitmap\Small\TCommandButton.bmp" TCOMMANDBUTTON32 BITMAP "Bitmap\Large\TCommandButton.bmp" diff --git a/Source/Compiled/uAdvCtrls.dcu b/Source/Compiled/uAdvCtrls.dcu index f79647d..a291253 100644 Binary files a/Source/Compiled/uAdvCtrls.dcu and b/Source/Compiled/uAdvCtrls.dcu differ diff --git a/Source/Compiled/uBase.dcu b/Source/Compiled/uBase.dcu index 7de21f7..d31c5dc 100644 Binary files a/Source/Compiled/uBase.dcu and b/Source/Compiled/uBase.dcu differ diff --git a/Source/Compiled/uCalc.dcu b/Source/Compiled/uCalc.dcu new file mode 100644 index 0000000..8e47848 Binary files /dev/null and b/Source/Compiled/uCalc.dcu differ diff --git a/Source/Compiled/uCrypt.dcu b/Source/Compiled/uCrypt.dcu index d35d521..1d5b922 100644 Binary files a/Source/Compiled/uCrypt.dcu and b/Source/Compiled/uCrypt.dcu differ diff --git a/Source/Compiled/uFileCtrls.dcu b/Source/Compiled/uFileCtrls.dcu index 2d64d34..eeba666 100644 Binary files a/Source/Compiled/uFileCtrls.dcu and b/Source/Compiled/uFileCtrls.dcu differ diff --git a/Source/Compiled/uFileTools.dcu b/Source/Compiled/uFileTools.dcu index acb4e48..8d578c4 100644 Binary files a/Source/Compiled/uFileTools.dcu and b/Source/Compiled/uFileTools.dcu differ diff --git a/Source/Compiled/uFrmCtrls.dcu b/Source/Compiled/uFrmCtrls.dcu index 86372d4..160e058 100644 Binary files a/Source/Compiled/uFrmCtrls.dcu and b/Source/Compiled/uFrmCtrls.dcu differ diff --git a/Source/Compiled/uInit.dcu b/Source/Compiled/uInit.dcu index e1682fa..02c6bae 100644 Binary files a/Source/Compiled/uInit.dcu and b/Source/Compiled/uInit.dcu differ diff --git a/Source/Compiled/uLocalMgr.dcu b/Source/Compiled/uLocalMgr.dcu index 20cad01..2e91995 100644 Binary files a/Source/Compiled/uLocalMgr.dcu and b/Source/Compiled/uLocalMgr.dcu differ diff --git a/Source/Compiled/uScriptMgr.dcu b/Source/Compiled/uScriptMgr.dcu index 96c4bf9..25519aa 100644 Binary files a/Source/Compiled/uScriptMgr.dcu and b/Source/Compiled/uScriptMgr.dcu differ diff --git a/Source/Compiled/uSysCtrls.dcu b/Source/Compiled/uSysCtrls.dcu index 67db7da..65a3f46 100644 Binary files a/Source/Compiled/uSysCtrls.dcu and b/Source/Compiled/uSysCtrls.dcu differ diff --git a/Source/Compiled/uSysTools.dcu b/Source/Compiled/uSysTools.dcu index c18c88e..a27d7f3 100644 Binary files a/Source/Compiled/uSysTools.dcu and b/Source/Compiled/uSysTools.dcu differ diff --git a/Source/Compiled/uVirtObj.dcu b/Source/Compiled/uVirtObj.dcu index 05a5e0e..15c25b4 100644 Binary files a/Source/Compiled/uVirtObj.dcu and b/Source/Compiled/uVirtObj.dcu differ diff --git a/Source/Compiled/uWebCtrls.dcu b/Source/Compiled/uWebCtrls.dcu index 1e6416f..95cbcc2 100644 Binary files a/Source/Compiled/uWebCtrls.dcu and b/Source/Compiled/uWebCtrls.dcu differ diff --git a/Source/uCalc.pas b/Source/uCalc.pas new file mode 100644 index 0000000..40862fd --- /dev/null +++ b/Source/uCalc.pas @@ -0,0 +1,457 @@ +unit uCalc; + +interface + +uses + { Standard-Units } + SysUtils, Classes, Math, + { Andere Package-Units } + uBase, uSysTools; + +type + { Fehlermeldungen } + ECalculate = class(Exception); + EIdentifierExists = class(Exception); + +type + { Hilfsklassen } + TCalcOperation = (coAdd,coSub,coMul,coDiv,coMod,coExp); + TCalcOperations = set of TCalcOperation; + TDecimalSeparators = set of (dsPoint,dsComma); + TCalculatorOptions = set of (coBrackets,coOperatorsOrder); + +type + { Ereignisse } + TCalculatorCalculateEvent = procedure(Sender: TObject) of object; + TCalculatorConstantEvent = procedure(Sender: TObject; const Name: String) of object; + TCalculatorFunctionEvent = procedure(Sender: TObject; const Name: String; var Value: Extended) of object; + +type + TCalculatorTerm = record + private + { Private-Deklarationen } + FValue: Extended; + FOperation: TCalcOperation; + public + { Public-Deklarationen } + property Value: Extended read FValue write FValue; + property Operation: TCalcOperation read FOperation write FOperation; + end; + + TCalculatorTermArray = array of TCalculatorTerm; + + TCalculator = class; + + TCalculatorConstant = class(TCollectionItem) + private + { Private-Deklarationen } + FName: String; + FValue: Extended; + { Methoden } + procedure SetName(Value: String); + published + { Published-Deklarationen } + { Eigenschaften } + property Name: String read FName write SetName; + property Value: Extended read FValue write FValue; + { Methoden } + constructor Create(Collection: TCollection); override; + destructor Destroy; override; + end; + + TCalculatorConstants = class(TCollection) + private + { Private-Deklarationen } + FCalculator: TCalculator; + public + { Public-Deklarationen } + { Eigenschaften } + property Calculator: TCalculator read FCalculator write FCalculator; + { Methoden } + constructor Create(ItemClass: TCollectionItemClass; ACalculator: TCalculator); + destructor Destroy; override; + function IndexOf(Name: String): Integer; + end; + + TCalculator = class(TComponent) + private + { Ereignisse} + FCalculateEvent: TCalculatorCalculateEvent; + FConstantEvent: TCalculatorConstantEvent; + FFunctionEvent: TCalculatorFunctionEvent; + { Private-Deklarationen } + FAbout: TComponentAbout; + FExpression: String; + FValue: Extended; + FConstants: TCalculatorConstants; + FFunctions: TStrings; + FOperations: TCalcOperations; + FDecimalSeparators: TDecimalSeparators; + FOptions: TCalculatorOptions; + FError: Integer; + FTerms: TCalculatorTermArray; + { Methoden } + function GetFunctions: TStrings; + procedure SetFunctions(Value: TStrings); + protected + { Protected-Deklarationen } + function GetOperation(const Character: Char): TCalcOperation; + function CallConstant(const Name: String): Extended; + function CallFunction(const Name: String; Parameter: Extended): Extended; + function CalcOperation(A,B: Extended; Operation: TCalcOperation): Extended; + procedure RaiseError(const Text: String; Index: PChar); + public + { Public-Deklarationen } + { Eigenschaften } + property Value: Extended read FValue; + property Error: Integer read FError; + property Terms: TCalculatorTermArray read FTerms; + { Methoden } + constructor Create(AOwner: TComponent); overload; override; + constructor Create(AOwner: TComponent; AExpression: String); overload; + destructor Destroy; override; + function Compile: Boolean; + procedure Calculate; + published + { Published-Deklarationen } + { Ereignisse} + property OnCalculate: TCalculatorCalculateEvent read FCalculateEvent write FCalculateEvent; + property OnConstant: TCalculatorConstantEvent read FConstantEvent write FConstantEvent; + property OnFunction: TCalculatorFunctionEvent read FFunctionEvent write FFunctionEvent; + { Eigenschaften } + property About: TComponentAbout read FAbout; + property Expression: String read FExpression write FExpression; + property Constants: TCalculatorConstants read FConstants write FConstants; + property Functions: TStrings read GetFunctions write SetFunctions; + property Operations: TCalcOperations read FOperations write FOperations; + property DecimalSeparators: TDecimalSeparators read FDecimalSeparators write FDecimalSeparators; + property Options: TCalculatorOptions read FOptions write FOptions; + end; + + procedure Register; + +const + { Meta-Daten } + CalculatorComponent_Name = 'Calculator'; + CalculatorComponent_Version = 1.0; + CalculatorComponent_Copyright = 'Copyright © 2014'; + CalculatorComponent_Author = 'Dennis Göhlert a.o.'; + { Sonderzeichen für Ausdrücke } + CalcSeperators = ['.',',']; + CalcBrackets = ['(',')']; + CalcOperatorsPre = ['+','-']; + CalcOperators = CalcOperatorsPre + ['*','/','%','^']; + +implementation + +procedure Register; +begin + RegisterComponents(ComponentsPage,[TCalculator]); +end; + +{ ---------------------------------------------------------------------------- + TCalculatorConstant + ---------------------------------------------------------------------------- } + +constructor TCalculatorConstant.Create(Collection: TCollection); +begin + inherited; + FName := ''; + FValue := 0; +end; + +destructor TCalculatorConstant.Destroy; +begin + //... + inherited; +end; + +procedure TCalculatorConstant.SetName(Value: String); +begin + Value := LowerCase(Value); + if FName = Value then + begin + Exit; + end; + if (Length(Value) <> 0) and ((Collection as TCalculatorConstants).IndexOf(Value) <> -1) or ((Collection as TCalculatorConstants).Calculator.Functions.IndexOf(Value) <> -1) then + begin + raise EIdentifierExists.Create('Identifier redefined: "' + Value + '"'); + end; + FName := Value; + DisplayName := Value; +end; + +{ ---------------------------------------------------------------------------- + TCalculatorConstants + ---------------------------------------------------------------------------- } + +constructor TCalculatorConstants.Create(ItemClass: TCollectionItemClass; ACalculator: TCalculator); +begin + inherited Create(ItemClass); + FCalculator := ACalculator; +end; + +destructor TCalculatorConstants.Destroy; +begin + //... + inherited; +end; + +function TCalculatorConstants.IndexOf(Name: String): Integer; +var + Index: Integer; +begin + Result := -1; + for Index := 0 to Count - 1 do + begin + if (Items[Index] as TCalculatorConstant).Name = Name then + begin + Result := Index; + Exit; + end; + end; +end; + +{ ---------------------------------------------------------------------------- + TCalculator + ---------------------------------------------------------------------------- } + +constructor TCalculator.Create(AOwner: TComponent); +begin + inherited; + FAbout := TComponentAbout.Create(CalculatorComponent_Name,CalculatorComponent_Version,CalculatorComponent_Copyright,CalculatorComponent_Author); + FExpression := ''; + FValue := 0; + FConstants := TCalculatorConstants.Create(TCalculatorConstant,Self); + FFunctions := TStringList.Create; + FOperations := [coAdd,coSub,coMul,coDiv]; + FDecimalSeparators := [dsPoint]; + FOptions := [coBrackets,coOperatorsOrder]; + FError := 0; + SetLength(FTerms,0); + //Naturkonstante "Pi" wird automatisch hinzugefügt + with (Constants.Add as TCalculatorConstant) do + begin + Name := 'pi'; + Value := Pi; + end; +end; + +constructor TCalculator.Create(AOwner: TComponent; AExpression: String); +begin + Create(AOwner); + FExpression := AExpression; +end; + +destructor TCalculator.Destroy; +begin + FConstants.Free; + FFunctions.Free; + inherited; +end; + +function TCalculator.GetFunctions: TStrings; +begin + Result := FFunctions; +end; + +procedure TCalculator.SetFunctions(Value: TStrings); +var + Index: Integer; +begin + if Value <> nil then + begin + for Index := 0 to Value.Count - 1 do + begin + Value.Strings[Index] := Lowercase(Value.Strings[Index]); + if (Value.IndexOf(Value.Strings[Index]) <> Index) or (Constants.IndexOf(Value.Strings[Index]) <> -1) then + begin + raise EIdentifierExists.Create('Identifier redefined: "' + Value.Strings[Index] + '"'); + end; + end; + end; + (FFunctions as TStringList).Assign(Value); +end; + +function TCalculator.GetOperation(const Character: Char): TCalcOperation; +begin + case Character of + '+': Result := coAdd; + '-': Result := coSub; + '*': Result := coMul; + '/': Result := coDiv; + '%': Result := coMod; + '^': Result := coExp; + end; +end; + +function TCalculator.CallConstant(const Name: String): Extended; +begin + if Assigned(OnCalculate) then + begin + OnConstant(Self,Name); + end; + Result := (Constants.Items[Constants.IndexOf(Name)] as TCalculatorConstant).Value; +end; + +function TCalculator.CallFunction(const Name: String; Parameter: Extended): Extended; +var + Value: Extended; +begin + Value := Parameter; + if Assigned(OnCalculate) then + begin + OnFunction(Self,Name,Value); + end; + Result := Value; +end; + +function TCalculator.CalcOperation(A,B: Extended; Operation: TCalcOperation): Extended; +begin + case Operation of + coAdd: Result := A + B; + coSub: Result := A - B; + coMul: Result := A * B; + coDiv: Result := A / B; + coMod: Result := FloatMod(A,B); + coExp: Result := Power(A,B); + end; +end; + +procedure TCalculator.RaiseError(const Text: String; Index: PChar); +begin + FError := CharPosition(Index,Expression); + raise ECalculate.Create('Error at position ' + IntToStr(Error) + ': ' + Text); +end; + +function TCalculator.Compile: Boolean; +var + Current: PChar; + Block: array of Char; + WantNumber: Boolean; + WantOperator: Boolean; +begin + if Assigned(OnCalculate) then + begin + OnCalculate(Self); + end; + if Length(Expression) = 0 then + begin + Exit; + end; + Result := False; + Current := @Expression[1]; + SetLength(FTerms,1); + WantNumber := True; + WantOperator := True; + while Current^ <> #0 do + begin + if Current^ in Spaces then + begin + if Length(Block) <> 0 then + begin + WantNumber := False; + end; + end else + begin + if Current^ in Numbers + Letters then + begin + if WantNumber = True then + begin + SetLength(Block,Length(Block) + 1); + Block[Length(Block)] := Current^; + end else + begin + RaiseError('Missing operator',Current); + end; + end else + begin + if Current^ in CalcOperators then + begin + if WantOperator = True then + begin + Terms[Length(Terms)].Operation := GetOperation(Current^); + WantOperator := False; + end else + begin + RaiseError('Multiple operators',Current); + end; + end; + end; + end; + Inc(Current); + end; + if (WantNumber = True) or (WantOperator = True) then + begin + RaiseError('Incomplete expression',Current); + end; + Result := True; +end; + +procedure TCalculator.Calculate; +var + Recent,Current,Last: ^TCalculatorTerm; +begin + FValue := 0; + if Length(Terms) = 0 then + begin + Exit; + end; + Last := @Terms[High(Terms)]; + Inc(Last); + // +1 -3 *5 [^2 ] +2 + // +1 -3 [*25] ^4 +2 + // [+1 ] [-75] *25 ^4 [+2 ] + if coOperatorsOrder in Options then + begin + //Exp + Current := @Terms[0]; + while Current <> Last do + begin + if Current^.Operation = coExp then + begin + Recent^.Value := CalcOperation(Recent^.Value,Current^.Value,coExp); + end else + begin + Recent := @Current^; + end; + Inc(Current); + end; + //Mul,Div,Mod + Current := @Terms[0]; + while Current <> Last do + begin + if Current^.Operation in [coMul,coDiv,coMod] then + begin + Recent^.Value := CalcOperation(Recent^.Value,Current^.Value,Current^.Operation); + end else + begin + if Current^.Operation <> coExp then + begin + Recent := @Current^; + end; + end; + Inc(Current); + end; + //Add,Sub + Current := @Terms[0]; + while Current <> Last do + begin + if Current^.Operation in [coAdd,coSub] then + begin + FValue := CalcOperation(Value,Current^.Value,Current^.Operation); + end; + Inc(Current); + end; + end else + begin + Current := @Terms[0]; + while Current <> Last do + begin + FValue := CalcOperation(Value,Current.Value,Current.Operation); + Inc(Current); + end; + end; +end; + +end. diff --git a/Source/uInit.pas b/Source/uInit.pas index af86a7a..45f05d1 100644 --- a/Source/uInit.pas +++ b/Source/uInit.pas @@ -74,6 +74,12 @@ initialization unterstützt. } {$MESSAGE ERROR 'Lina Components requires Delphi 7 or higher'} {$IFEND} + {$IF CompilerVersion < 17.0} + { Unter früheren Delphi-Versionen als 2005 gab es noch nicht dieMöglichkeit, + Records mit methoden zu versehen. Die Implementierung von Prozeduren und/ + oder Funktionen war Klassen vorenthalten. } + {$DEFINE NO_RECORDMETHODS} + {$IFEND} {$IF CompilerVersion < 18.5} { Unter früheren Delphi-Versionen als 2007 gab es (offiziell) noch keine Unterstützung für Windows-Vista-spezifische funktionen wie die TaskDialog- diff --git a/Source/uLocalMgr.pas b/Source/uLocalMgr.pas index 9a69464..a419636 100644 --- a/Source/uLocalMgr.pas +++ b/Source/uLocalMgr.pas @@ -16,15 +16,13 @@ interface uses { Standard-Units } - SysUtils, Classes, Controls, Forms, StdCtrls, ExtCtrls, ComCtrls, Dialogs, - Menus, Buttons, + SysUtils, Classes, Controls, Forms, TypInfo, { Andere Package-Units } uBase, uSysTools; type { Fehlermeldungen } EInvalidFormat = class(Exception); - EUnsupportedComponent = class(Exception); ELanguageTagExists = class(Exception); ELocalizationParse = class(Exception); @@ -171,23 +169,25 @@ type TLocalizationReference = class(TCollectionItem) private { Private-Deklarationen } + FComponent: TComponent; FSection: String; FIndent: String; FReference: PString; - FComponent: TComponent; + FField: String; { Methoden } procedure SetIndent(Value: String); - procedure SetComponent(Value: TComponent); procedure Apply; public { Public-Deklarationen } + constructor Create(Collection: TCollection); override; destructor Destroy; override; property Reference: PString read FReference write FReference; published { Published-Deklarationen } + property Component: TComponent read FComponent write FComponent; property Section: String read FSection write FSection; property Indent: String read FIndent write SetIndent; - property Component: TComponent read FComponent write SetComponent; + property Field: String read FField write FField; end; TLocalizationApplier = class @@ -205,8 +205,9 @@ type procedure Apply; protected { Protected-Deklarationen } - procedure ApplyToComponent(Component: TComponent; Section,Indent: String); + procedure ApplyToComponent(Component: TComponent; Field,Section,Indent: String); procedure ApplyToForm(Form: TCustomForm); + procedure ApplyToFormEx(Form: TCustomForm); procedure ApplyToAll; published { Published-Deklarationen } @@ -946,6 +947,14 @@ end; TLocalizationReference ---------------------------------------------------------------------------- } +constructor TLocalizationReference.Create(Collection: TCollection); +begin + inherited; + Section := ''; + Indent := 'Reference' + IntToStr(ID); + Field := ''; +end; + destructor TLocalizationReference.Destroy; begin Component := nil; @@ -971,34 +980,13 @@ begin FIndent := Value; end; -procedure TLocalizationReference.SetComponent(Value: TComponent); -begin - if (Value is TForm) or (Value is TButton) or (Value is TEdit) or - (Value is TCheckBox) or (Value is TComboBox) or (Value is TMemo) or - (Value is TListBox) or (Value is TLabel) or (Value is TStaticText) or - (Value is TGroupBox) or (Value is TRadioButton) or (Value is TPanel) or - (Value is TRadioGroup) or (Value is TStatusBar) or (Value is TTabSheet) or - (Value is TOpenDialog) or (Value is TRichEdit) or (Value is TMenuItem) or - (Value is TBitBtn) or (Value is TSpeedButton) or (Value is TLabeledEdit) or - (Value is TBoundLabel) or (Value = nil) then - begin - FComponent := Value; - end else - begin - raise EUnsupportedComponent.Create('"' + Value.ClassName + '" is an unsupported class'); - end; -end; - procedure TLocalizationReference.Apply; -{ Alle (relevanten) Controls aus der Unit "StdCtrls", "Buttons", sowie alle - herkömmlichen Dialoge (nicht Vista-Dialoge), TPanel, TRadioGroup, TStatusBar, - TTabSheet, TMenuItem, und TForm werden unterstützt. } begin if Reference <> nil then begin Reference^ := (Collection as TLocalizationReferences).FManager.Data.ReadString(Section,Indent,Reference^); end; - (Collection as TLocalizationReferences).FManager.Applier.ApplyToComponent(Component,Section,Indent); + (Collection as TLocalizationReferences).FManager.Applier.ApplyToComponent(Component,Field,Section,Indent); end; { ---------------------------------------------------------------------------- @@ -1029,158 +1017,82 @@ begin case FApplyMode of laCustom: FManager.References.Apply; laAll: ApplyToAll; - laMainForm: ApplyToForm(Application.MainForm); + laMainForm: ApplyToFormEx(Application.MainForm); end; end; -procedure TLocalizationApplier.ApplyToComponent(Component: TComponent; Section,Indent: String); +procedure TLocalizationApplier.ApplyToComponent(Component: TComponent; Field,Section,Indent: String); begin if Assigned(Component) = True then begin - //TForm - if Component is TForm then - begin - (Component as TForm).Caption := FManager.Data.ReadString(Section,Indent,(Component as TForm).Caption); - Exit; - end; - //TButton - if Component is TButton then - begin - (Component as TButton).Caption := FManager.Data.ReadString(Section,Indent,(Component as TButton).Caption); - Exit; - end; - //TEdit - if Component is TEdit then - begin - (Component as TEdit).Text := FManager.Data.ReadString(Section,Indent,(Component as TEdit).Text); - Exit; - end; - //TLabeledEdit - if Component is TLabeledEdit then - begin - (Component as TLabeledEdit).Text := FManager.Data.ReadString(Section,Indent,(Component as TLabeledEdit).Text); - Exit; - end; - //TBoundLabel - if Component is TBoundLabel then - begin - (Component as TBoundLabel).Caption := FManager.Data.ReadString(Section,Indent,(Component as TBoundLabel).Caption); - Exit; - end; - //TCheckBox - if Component is TCheckBox then - begin - (Component as TCheckBox).Caption := FManager.Data.ReadString(Section,Indent,(Component as TCheckBox).Caption); - Exit; - end; - //TComboBox - if Component is TComboBox then - begin - (Component as TComboBox).Text := FManager.Data.ReadString(Section,Indent,(Component as TComboBox).Text); - Exit; - end; - //TMemo - if Component is TMemo then - begin - (Component as TMemo).Text := FManager.Data.ReadString(Section,Indent,(Component as TMemo).Text); - Exit; - end; - //TListBox - if Component is TListBox then - begin - (Component as TListBox).Items.Text := FManager.Data.ReadString(Section,Indent,(Component as TListBox).Items.Text); - Exit; - end; - //TLabel - if Component is TLabel then - begin - (Component as TLabel).Caption := FManager.Data.ReadString(Section,Indent,(Component as TLabel).Caption); - Exit; - end; - //TStaticText - if Component is TStaticText then - begin - (Component as TStaticText).Caption := FManager.Data.ReadString(Section,Indent,(Component as TStaticText).Caption); - Exit; - end; - //TGroupBox - if Component is TGroupBox then - begin - (Component as TGroupBox).Caption := FManager.Data.ReadString(Section,Indent,(Component as TGroupBox).Caption); - Exit; - end; - //TRadioButton - if Component is TRadioButton then - begin - (Component as TRadioButton).Caption := FManager.Data.ReadString(Section,Indent,(Component as TRadioButton).Caption); - Exit; - end; - //TPanel - if Component is TPanel then - begin - (Component as TPanel).Caption := FManager.Data.ReadString(Section,Indent,(Component as TPanel).Caption); - Exit; - end; - //TRadioGroup - if Component is TRadioGroup then - begin - (Component as TRadioGroup).Caption := FManager.Data.ReadString(Section,Indent,(Component as TRadioGroup).Caption); - Exit; - end; - //TStatusBar - if Component is TStatusBar then - begin - (Component as TStatusBar).SimpleText := FManager.Data.ReadString(Section,Indent,(Component as TStatusBar).SimpleText); - Exit; - end; - //TTabSheet - if Component is TTabSheet then - begin - (Component as TTabSheet).Caption := FManager.Data.ReadString(Section,Indent,(Component as TTabSheet).Caption); - Exit; - end; - //TOpenDialog - if Component is TOpenDialog then - begin - (Component as TOpenDialog).Title := FManager.Data.ReadString(Section,Indent,(Component as TOpenDialog).Title); - Exit; - end; - //TRichEdit - if Component is TRichEdit then - begin - (Component as TRichEdit).Text := FManager.Data.ReadString(Section,Indent,(Component as TRichEdit).Text); - Exit; - end; - //TMenuItem - if Component is TMenuItem then - begin - (Component as TMenuItem).Caption := FManager.Data.ReadString(Section,Indent,(Component as TMenuItem).Caption); - Exit; - end; - //TBitBtn - if Component is TBitBtn then - begin - (Component as TBitBtn).Caption := FManager.Data.ReadString(Section,Indent,(Component as TBitBtn).Caption); - Exit; - end; - //TSpeedButton - if Component is TSpeedButton then - begin - (Component as TSpeedButton).Caption := FManager.Data.ReadString(Section,Indent,(Component as TSpeedButton).Caption); - end; + SetStrSubProp(Component,Field,FManager.Data.ReadString(Section,Indent,GetStrSubProp(Component,Field))); end; end; procedure TLocalizationApplier.ApplyToForm(Form: TCustomForm); +{ Empfehlenswert, falls mehrere Formulare lokalisiert werden sollen. Falls ein + einziges Formular automatisch lokalisiert werden soll, sollte die Methode + "ApplyToFormEx(TCustomForm)" verwendet werden. + Definiert die Eigenschaften eines Formulars und deren Komponenten über den + Inhalt der TLocalization.Lines-Eigenschaft. + Es wird erwartet, dass die Definitionen so vorliegen, dass jedes Formular + einen eigenen Abschnitt besitzt und jedes zu definierende Feld ein Eintrag + ist. Für Eigenschaften von Komponenten müssen diese dem Namen des Eintrags + vorweg-gestellt sein. } var Index: Integer; + Indents: TStrings; begin if Assigned(Form) = True then begin - ApplyToComponent(Form,'',Form.Name); - for Index := 0 to Form.ComponentCount - 1 do - begin - ApplyToComponent(Form.Components[Index],Form.Name,Form.Components[Index].Name); + Indents := TStringList.Create; + try + FManager.Data.ReadIndents(Form.Name,Indents); + for Index := 0 to Indents.Count - 1 do + begin + ApplyToComponent(Form,Indents.Strings[Index],Form.Name,Indents.Strings[Index]); + end; + finally + Indents.Free; + end; + end; +end; + +procedure TLocalizationApplier.ApplyToFormEx(Form: TCustomForm); +{ Empfehlenswert, falls ein einziges Formular automatisch lokalisiert werden + soll. Falls mehrere Formulare lokalisiert werden sollen, sollte die Methode + "ApplyToForm(TCustomForm)" verwendet werden. + Definiert die Eigenschaften eines Formulars und deren Komponenten EXKLUSIV (!) + über den Inhalt der TLocalization.Lines-Eigenschaft. + Es wird erwartet, dass die Definitionen so vorliegen, dass jede Komponente + einen eigenen Abschnitt besitzt und jedes zu definierende Feld ein Eintrag + ist. Für das Formular selber ist der namenlose (Kopf-)Abschnitt vorgesehen. } +var + Index_Section: Integer; + Index_Indent: Integer; + Indents: TStrings; +begin + if Assigned(Form) = True then + begin + Indents := TStringList.Create; + try + //Formular + FManager.Data.ReadIndents('',Indents); + for Index_Indent := 0 to Indents.Count - 1 do + begin + ApplyToComponent(Form,Indents.Strings[Index_Indent],'',Indents.Strings[Index_Indent]); + end; + //Komponenten + for Index_Section := 0 to Form.ComponentCount - 1 do + begin + FManager.Data.ReadIndents(Form.Components[Index_Section].Name,Indents); + for Index_Indent := 0 to Indents.Count - 1 do + begin + ApplyToComponent(Form.Components[Index_Section],Indents.Strings[Index_Indent],Form.Components[Index_Section].Name,Indents.Strings[Index_Indent]); + end; + end; + finally + Indents.Free; end; end; end; diff --git a/Source/uSysTools.pas b/Source/uSysTools.pas index ecad5c9..d31dcd3 100644 --- a/Source/uSysTools.pas +++ b/Source/uSysTools.pas @@ -16,7 +16,7 @@ interface uses { Standard-Units } - SysUtils, Classes, Math, Windows, Graphics, Printers + SysUtils, Classes, Math, Windows, Graphics, Printers, TypInfo {$IFNDEF NO_GENERIC} ,Generics.Collections {$ENDIF} @@ -143,7 +143,7 @@ type end; TFloatRefDataArrayReferenceDataArray = array of TFloatRefDataArrayReferenceData; - TCycle = record + TCycle = {$IFDEF NO_RECORDMETHODS} record {$ELSE} class {$ENDIF} private { Private-Deklarationen } FRadius: Extended; @@ -244,6 +244,41 @@ type function PQFormula(P,Q: Double): TDoubleArray; overload; function PQFormula(P,Q: Real): TRealArray; overload; function PQFormula(P,Q: Extended): TExtendedArray; overload; + { Gleitkomma-Modulo } + function FloatMod(X,Y: Single): Single; overload; + function FloatMod(X,Y: Double): Double; overload; + function FloatMod(X,Y: Real): Real; overload; + function FloatMod(X,Y: Extended): Extended; overload; + { RTTI-Werzeuge } + function GetSubPropInfo(Instance: TObject; const PropName: String; AKinds: TTypeKinds = []): PPropInfo; + function GetObjectSubProp(Instance: TObject; const PropName: String): TObject; + procedure SetObjectSubProp(Instance: TObject; const PropName: String; Value: TObject); + function GetVariantSubProp(Instance: TObject; const PropName: String): Variant; + procedure SetVariantSubProp(Instance: TObject; const PropName: String; Value: Variant); + function GetStrSubProp(Instance: TObject; const PropName: String): String; + procedure SetStrSubProp(Instance: TObject; const PropName: String; Value: String); + {$IFNDEF NO_UNICODE} + function GetAnsiStrSubProp(Instance: TObject; const PropName: String): AnsiString; + procedure SetAnsiStrSubProp(Instance: TObject; const PropName: String; Value: AnsiString); + {$ENDIF} + function GetInt64SubProp(Instance: TObject; const PropName: String): Int64; + procedure SetInt64SubProp(Instance: TObject; const PropName: String; Value: Int64); + function GetFloatSubProp(Instance: TObject; const PropName: String): Extended; + procedure SetFloatSubProp(Instance: TObject; const PropName: String; Value: Extended); + function GetOrdSubProp(Instance: TObject; const PropName: String): NativeInt; + procedure SetOrdSubProp(Instance: TObject; const PropName: String; Value: NativeInt); + function GetEnumSubProp(Instance: TObject; const PropName: String): String; + procedure SetEnumSubProp(Instance: TObject; const PropName: String; Value: String); + function GetSetSubProp(Instance: TObject; const PropName: String): String; + procedure SetSetSubProp(Instance: TObject; const PropName: String; Value: String); + function GetDynArraySubProp(Instance: TObject; const PropName: String): Pointer; + procedure SetDynArraySubProp(Instance: TObject; const PropName: String; Value: Pointer); + function GetInterfaceSubProp(Instance: TObject; const PropName: String): IInterface; + procedure SetInterfaceSubProp(Instance: TObject; const PropName: String; Value: IInterface); + function GetMethodSubProp(Instance: TObject; const PropName: String): TMethod; + procedure SetMethodSubProp(Instance: TObject; const PropName: String; Value: TMethod); + function SubPropIsType(Instance: TObject; const PropName: String; TypeKind: TTypeKind): Boolean; + function SubPropType(Instance: TObject; const PropName: String): TTypeKind; overload; { Sonstige } function SecToTime(const Sec: Cardinal): TTime; function GetExecTime(Command: Pointer; Amount: Cardinal; Attempts: Cardinal = 1): Cardinal; @@ -257,6 +292,12 @@ type function IntToStrMinLength(Value: Integer; MinLength: SmallInt): String; function MultiPos(const SubStr, Str: ShortString; Offset: Integer = 1): TIntegerArray; overload; function MultiPos(const SubStr, Str: String; Offset: Integer = 1): TIntegerArray; overload; + function CharLine(Current: PAnsiChar; Text: AnsiString): Integer; {$IFNDEF NO_UNICODE} overload; + function CharLine(Current: PWideChar; Text: UnicodeString): Integer; overload; + {$ENDIF} + function CharPosition(Current: PAnsiChar; Text: AnsiString): Integer; {$IFNDEF NO_UNICODE} overload; + function CharPosition(Current: PWideChar; Text: UnicodeString): Integer; overload; + {$ENDIF} procedure PrintText(Strings: TStrings; Font: TFont); procedure ExtractChars(var Text: String; Chars: array of Char); procedure EnableDebugPrivilege; @@ -275,7 +316,7 @@ uses function BoolToInt(B: Boolean): Integer; begin - Result := -Integer(B) + Result := -Integer(B); end; function IntToBool(Value: Integer): Boolean; @@ -587,6 +628,406 @@ begin end; end; +function FloatMod(X,Y: Single): Single; +begin + Result := X - Y * Trunc(X / Y); +end; + +function FloatMod(X,Y: Double): Double; +begin + Result := X - Y * Trunc(X / Y); +end; + +function FloatMod(X,Y: Real): Real; +begin + Result := X - Y * Trunc(X / Y); +end; + +function FloatMod(X,Y: Extended): Extended; +begin + Result := X - Y * Trunc(X / Y); +end; + +function GetSubPropInfo(Instance: TObject; const PropName: String; AKinds: TTypeKinds = []): PPropInfo; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetPropInfo(Instance,Trim(PropName),AKinds); + end else + begin + Result := GetSubPropInfo(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),AKinds); + end; +end; + +function GetObjectSubProp(Instance: TObject; const PropName: String): TObject; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetObjectProp(Instance,Trim(PropName)); + end else + begin + Result := GetObjectSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetObjectSubProp(Instance: TObject; const PropName: String; Value: TObject); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetObjectProp(Instance,Trim(PropName),Value); + end else + begin + SetObjectSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetVariantSubProp(Instance: TObject; const PropName: String): Variant; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetVariantProp(Instance,Trim(PropName)); + end else + begin + Result := GetVariantSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetVariantSubProp(Instance: TObject; const PropName: String; Value: Variant); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetVariantProp(Instance,Trim(PropName),Value); + end else + begin + SetVariantSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetStrSubProp(Instance: TObject; const PropName: String): String; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetStrProp(Instance,Trim(PropName)); + end else + begin + Result := GetStrSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetStrSubProp(Instance: TObject; const PropName: String; Value: String); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetStrProp(Instance,Trim(PropName),Value); + end else + begin + SetStrSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +{$IFNDEF NO_UNICODE} +function GetAnsiStrSubProp(Instance: TObject; const PropName: String): AnsiString; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetAnsiStrProp(Instance,Trim(PropName)); + end else + begin + Result := GetAnsiStrSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetAnsiStrSubProp(Instance: TObject; const PropName: String; Value: AnsiString); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetAnsiStrProp(Instance,Trim(PropName),Value); + end else + begin + SetAnsiStrSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; +{$ENDIF} + +function GetInt64SubProp(Instance: TObject; const PropName: String): Int64; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetInt64Prop(Instance,Trim(PropName)); + end else + begin + Result := GetInt64SubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetInt64SubProp(Instance: TObject; const PropName: String; Value: Int64); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetInt64Prop(Instance,Trim(PropName),Value); + end else + begin + SetInt64SubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetFloatSubProp(Instance: TObject; const PropName: String): Extended; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetFloatProp(Instance,Trim(PropName)); + end else + begin + Result := GetFloatSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetFloatSubProp(Instance: TObject; const PropName: String; Value: Extended); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetFloatProp(Instance,Trim(PropName),Value); + end else + begin + SetFloatSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetOrdSubProp(Instance: TObject; const PropName: String): NativeInt; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetOrdProp(Instance,Trim(PropName)); + end else + begin + Result := GetOrdSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetOrdSubProp(Instance: TObject; const PropName: String; Value: NativeInt); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetOrdProp(Instance,Trim(PropName),Value); + end else + begin + SetOrdSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetEnumSubProp(Instance: TObject; const PropName: String): String; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetEnumProp(Instance,Trim(PropName)); + end else + begin + Result := GetEnumSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetEnumSubProp(Instance: TObject; const PropName: String; Value: String); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetEnumProp(Instance,Trim(PropName),Value); + end else + begin + SetEnumSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetSetSubProp(Instance: TObject; const PropName: String): String; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetSetProp(Instance,Trim(PropName)); + end else + begin + Result := GetSetSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetSetSubProp(Instance: TObject; const PropName: String; Value: String); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetSetProp(Instance,Trim(PropName),Value); + end else + begin + SetSetSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetDynArraySubProp(Instance: TObject; const PropName: String): Pointer; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetDynArrayProp(Instance,Trim(PropName)); + end else + begin + Result := GetDynArraySubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetDynArraySubProp(Instance: TObject; const PropName: String; Value: Pointer); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetDynArrayProp(Instance,Trim(PropName),Value); + end else + begin + SetDynArraySubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetInterfaceSubProp(Instance: TObject; const PropName: String): IInterface; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetInterfaceProp(Instance,Trim(PropName)); + end else + begin + Result := GetInterfaceSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetInterfaceSubProp(Instance: TObject; const PropName: String; Value: IInterface); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetInterfaceProp(Instance,Trim(PropName),Value); + end else + begin + SetInterfaceSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function GetMethodSubProp(Instance: TObject; const PropName: String): TMethod; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := GetMethodProp(Instance,Trim(PropName)); + end else + begin + Result := GetMethodSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + +procedure SetMethodSubProp(Instance: TObject; const PropName: String; Value: TMethod); +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + SetMethodProp(Instance,Trim(PropName),Value); + end else + begin + SetMethodSubProp(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),Value); + end; +end; + +function SubPropIsType(Instance: TObject; const PropName: String; TypeKind: TTypeKind): Boolean; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := PropIsType(Instance,Trim(PropName),TypeKind); + end else + begin + Result := SubPropIsType(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2),TypeKind); + end; +end; + +function SubPropType(Instance: TObject; const PropName: String): TTypeKind; +var + DotPos: Integer; +begin + DotPos := Pos(DotSep,PropName); + if DotPos = 0 then + begin + Result := PropType(Instance,Trim(PropName)); + end else + begin + Result := SubPropType(GetObjectProp(Instance,Trim(Copy(PropName,1,DotPos - 1))),Copy(PropName,DotPos + 1,Length(PropName) - 2)); + end; +end; + function SecToTime(const Sec: Cardinal): TTime; var Hrs, Mins: Word; @@ -1119,6 +1560,156 @@ begin end; end; +function CharLine(Current: PAnsiChar; Text: AnsiString): Integer; +var + Index: PAnsiChar; + InLineBreak: PAnsiChar; + Position: Integer; +begin + Position := Pos(AnsiString(Current),Text); + if Position = 0 then + begin + Result := -1; + Exit; + end; + Result := 0; + SetLength(Text,Position - 1); + InLineBreak := @sLineBreak[1]; + Index := PAnsiChar(Text); + while Index^ <> #0 do + begin + if Index^ = InLineBreak^ then + begin + Inc(InLineBreak); + if InLineBreak^ = #0 then + begin + Inc(Result); + InLineBreak := @sLineBreak[1]; + end; + end else + begin + InLineBreak := @sLineBreak[1]; + end; + Inc(Index); + end; +end; + +{$IFNDEF NO_UNICODE} +function CharLine(Current: PWideChar; Text: UnicodeString): Integer; +var + Index: PWideChar; + InLineBreak: PWideChar; + Position: Integer; + UnicodeLineBreak: UnicodeString; +begin + Position := Pos(UnicodeString(Current),Text); + if Position = 0 then + begin + Result := -1; + Exit; + end; + UnicodeLineBreak := UnicodeString(sLineBreak); + Result := 0; + SetLength(Text,Position - 1); + InLineBreak := @UnicodeLineBreak[1]; + Index := PChar(Text); + while Index^ <> #0 do + begin + if Index^ = InLineBreak^ then + begin + Inc(InLineBreak); + if InLineBreak^ = #0 then + begin + Inc(Result); + InLineBreak := @UnicodeLineBreak[1]; + end; + end else + begin + InLineBreak := @UnicodeLineBreak[1]; + end; + Inc(Index); + end; +end; +{$ENDIF} + +function CharPosition(Current: PAnsiChar; Text: AnsiString): Integer; +var + Index: PAnsiChar; + InLineBreak: PAnsiChar; + Position: Integer; + Line: Integer; +begin + Position := Pos(AnsiString(Current),Text); + if Position = 0 then + begin + Result := 0; + Exit; + end; + Result := 1; + SetLength(Text,Position - 1); + InLineBreak := @sLineBreak[1]; + Index := PAnsiChar(Text); + while Index^ <> #0 do + begin + if Index^ = InLineBreak^ then + begin + Inc(InLineBreak); + if InLineBreak^ = #0 then + begin + Result := 1; + Inc(Line); + InLineBreak := @sLineBreak[1]; + end; + end else + begin + InLineBreak := @sLineBreak[1]; + Inc(Result); + end; + Inc(Index); + end; +end; + +{$IFNDEF NO_UNICODE} +function CharPosition(Current: PWideChar; Text: UnicodeString): Integer; +var + Index: PWideChar; + InLineBreak: PWideChar; + Position: Integer; + UnicodeLineBreak: UnicodeString; + Line: Integer; +begin + Position := Pos(UnicodeString(Current),Text); + if Position = 0 then + begin + Result := 0; + Exit; + end; + UnicodeLineBreak := UnicodeString(sLineBreak); + Result := 1; + SetLength(Text,Position - 1); + InLineBreak := @UnicodeLineBreak[1]; + Index := PChar(Text); + while Index^ <> #0 do + begin + if Index^ = InLineBreak^ then + begin + Inc(InLineBreak); + if InLineBreak^ = #0 then + begin + Result := 1; + Inc(Line); + InLineBreak := @UnicodeLineBreak[1]; + end; + end else + begin + InLineBreak := @UnicodeLineBreak[1]; + Inc(Result); + end; + Inc(Index); + end; +end; +{$ENDIF} + procedure PrintText(Strings: TStrings; Font: TFont); var Index: Integer; diff --git a/Source/uWebCtrls.pas b/Source/uWebCtrls.pas index de9c70e..c03868a 100644 --- a/Source/uWebCtrls.pas +++ b/Source/uWebCtrls.pas @@ -25,6 +25,7 @@ uses type { Fehlermeldungen } EInvalidWebAddress = class(Exception); + EInvalidTagChar = class(Exception); type { Ereignisse } @@ -93,6 +94,7 @@ var procedure InitializeProtocols; function ValidProtocol(const Protocol: TWebProtocol; const Protocols: TWebProtocols): Boolean; function StrIsURL(const S: String): Boolean; + function GetTagParamValue(const S,Tag,Param: String): String; procedure Register; @@ -237,6 +239,122 @@ begin Result := (ProtocolValid and (DomainLength > 3)); end; +function GetTagParamValue(const S,Tag,Param: String): String; +{ Ziemlich schneller XML/HTML-Parser, der nach einem Tag und einem dort + enthaltenem Parameter sucht. Der Wert dieses Parameters wird dann + als Ergebnis der Funktion zurückgegeben. } +var + Finished: Boolean; + Current: PChar; + InTag,InValue: Boolean; + Ignore: Boolean; + Equal: Boolean; + Block: String; +begin + Result := ''; + if (Length(S) < 4) or (Length(Tag) = 0) or (Length(Param) = 0) then + begin + Exit; + end; + Finished := False; + InTag := False; + InValue := False; + Ignore := True; + Equal := False; + Block := ''; + Current := @S[1]; + while True do + begin + if InTag = True then + begin + if InValue = True then + begin + if Current^ = '"' then + begin + InValue := False; + if Ignore = False then + begin + Result := Block; + Exit; + end; + Block := ''; + Equal := False; + end else + begin + Block := Block + Current^; + end; + //--> + Inc(Current); + Continue; + end; + if Equal = True then + begin + if Current^ in Spaces then + begin + //--> + Inc(Current); + Continue; + end; + if Current^ = '"' then + begin + InValue := True; + Ignore := not ((Ignore = True) and (Block = Param)); + Block := ''; + //--> + Inc(Current); + Continue; + end; + end else + begin + if Current^ in Letters + Numbers then + begin + Block := Block + Current^; + //--> + Inc(Current); + Continue; + end; + if Current^ = '>' then + begin + InTag := False; + Block := ''; + //--> + Inc(Current); + Continue; + end; + if Current^ in Spaces then + begin + if Block = Tag then + begin + Ignore := False; + end; + Block := ''; + //--> + Inc(Current); + Continue; + end; + if Current^ = '=' then + begin + Equal := True; + //--> + Inc(Current); + Continue; + end; + end; + end else + begin + if Current^ = '<' then + begin + InTag := True; + end; + //--> + Inc(Current); + Continue; + end; + raise EInvalidTagChar.Create('Invalid character: "' + Current^ + '"'); + Exit; + end; +end; + constructor TDownload.Create(AOwner: TComponent); begin inherited;